CristalCaveGem » LustreC

    | None           -> []

    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in

  fun v -> is_aliasable v && List.mem v.var_id inputs_var

(* replace variable [v] by [v'] in graph [g].

   [v'] is a dead variable

*)

  end

(* tests whether a variable [v] may be (re)used instead of [var]. The conditions are:

   - same type

   - [v] is not an aliasable input of the equation defining [var]

   - [v] is not one of the current heads (which contain [var])

 *)

let eligible node ctx heads var v =

  && not (is_aliasable_input node var.var_id v)

  && not (List.exists (fun h -> h.var_id = v.var_id) heads)

let compute_reuse node ctx heads var =

  let disjoint = Hashtbl.find ctx.disjoint var.var_id in

  let locally_reusable v =

    IdentDepGraph.fold_pred (fun p r -> r && Disjunction.CISet.exists (fun d -> p = d.var_id) disjoint) ctx.dep_graph v.var_id true in

  let eligibles = Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in

  let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in

  try

    let disjoint_live = Disjunction.CISet.inter disjoint live in

    let reuse = Disjunction.CISet.max_elt disjoint_live in

    begin

      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;

      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;

      (*Format.eprintf "%s reused by live@." var.var_id;*)

    end

  with Not_found ->

  try

    let dead = Disjunction.CISet.filter (fun v -> is_graph_root v.var_id ctx.dep_graph) quasi_dead in

    let reuse = Disjunction.CISet.choose dead in

    begin

      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;

      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;

      (*Format.eprintf "%s reused by dead %a@." var.var_id Disjunction.pp_ciset dead;*)

    end

    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);

    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in

    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");

    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");

    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");

    compute_dependencies heads ctx;