CristalCaveGem » LustreC

      actual_s : var_decl

    }

let as_clock var_decl =

  let tydec = var_decl.var_dec_type in

  { var_decl with var_dec_type = { ty_dec_desc = Tydec_clock tydec.ty_dec_desc; ty_dec_loc = tydec.ty_dec_loc } }

let mkident loc id =

 mkexpr loc (Expr_ident id)

let mkfby loc e1 e2 =

 mkexpr loc (Expr_arrow (e1, mkexpr loc (Expr_pre e2)))

let mkidentpair loc restart state =

 mkexpr loc (Expr_tuple [mkident loc restart; mkident loc state])

    node_id = node_id;

    node_type = Types.new_var ();

    node_clock = Clocks.new_var true;

    node_locals = [];

    node_gencalls = [];

    node_checks = [];

    node_id = node_id;

    node_type = Types.new_var ();

    node_clock = Clocks.new_var true;

    node_gencalls = [];

    node_checks = [];

    node_asserts = handler.hand_asserts; 

  let assign_until_expr = mkexpr aut.aut_loc (Expr_merge (aut_state.actual_s.var_id, assign_until_handlers)) in

  let assign_until_vars = [aut_state.incoming_r'.var_id; aut_state.incoming_s'.var_id] @ (ISet.elements all_outputs) in

  let assign_until_eq = mkeq aut.aut_loc (assign_until_vars, assign_until_expr) in

  let incoming_eq = mkeq aut.aut_loc ([aut_state.incoming_r.var_id; aut_state.incoming_s.var_id], fby_incoming_expr) in

  let locals' = vars_of_aut_state aut_state in

  let eqs' = [Eq unless_eq; Eq assign_until_eq; Eq incoming_eq] in

    | 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;

  if !Options.global_inline && !Options.main_node <> "" && !Options.witnesses then

    begin

      let orig = Corelang.copy_prog orig in

      check_stateless_decls orig;

      let _ = Typing.type_prog type_env orig in

      let _ = Clock_calculus.clock_prog clock_env orig in

      Inliner.witness 

	basename

	!Options.main_node

    end;

(*Format.eprintf "Inliner.global_inline<<@.%a@.>>@." Printers.pp_prog prog;*)

 | Tclock ty -> Some ty

 | _         -> None

let rec is_dimension_type ty =

 match (repr ty).tdesc with

 | Tint