CristalCaveGem » LustreC

  | Node nd -> nd.node_id = id 

  | _ -> false) 

let rename_expr rename expr = expr_replace_var rename expr

let rename_eq rename eq = 

  { eq with

    eq_lhs = List.map rename eq.eq_lhs; 

  }

(* 

We select the called node equations and variables.

   renamed_inputs = args

TODO: convert the specification/annotation/assert and inject them

TODO: deal with reset

*)

  let loc = orig_expr.expr_loc in

  let uid = orig_expr.expr_tag in

  let rename v =

  in

  let eqs' = List.map (rename_eq rename) (get_node_eqs node)

  in

  let inputs' = List.map rename_var node.node_inputs in

  let outputs' = List.map rename_var node.node_outputs in

  let locals' = List.map rename_var node.node_locals in

  (* checking we are at the appropriate (early) step: node_checks and

     node_gencalls should be empty (not yet assigned) *)

  assert (node.node_checks = []);

  assert (reset = None);

  let assign_inputs = mkeq loc (List.map (fun v -> v.var_id) inputs', args) in

  in

  let asserts' = (* We rename variables in assert expressions *)

    List.map 

(* 

   Each occurence of a node in nodes in the expr should be replaced by fresh

   variables and the code of called node instance added to new_eqs

*)

  let inline_expr = inline_expr ~selection_on_annotation:selection_on_annotation in

  let inline_node = inline_node ~selection_on_annotation:selection_on_annotation in

  let inline_tuple el = 

    List.fold_right (fun e (el_tail, locals, eqs, asserts) -> 

      e'::el_tail, locals', eqs'@eqs, asserts@asserts'

    ) el ([], locals, [], [])

  in

  match expr.expr_desc with

  | Expr_appl (id, args, reset) ->

    if List.exists (check_node_name id) nodes && (* the current node call is provided

						    as arguments nodes *)

      (not selection_on_annotation || is_inline_expr expr) (* and if selection on annotation is activated, 

							      it is explicitely inlined here *)

    then 

      (* The node should be inlined *)

	with Not_found -> (assert false) in

      let expr, locals', eqs'', asserts'' = 

      expr, locals', eqs'@eqs'', asserts'@asserts''

    else 

      (* let _ =     Format.eprintf "Not inlining call to %s@." id in *)

    let el', l', eqs', asserts' = inline_tuple el in

    { expr with expr_desc = Expr_array el' }, l', eqs', asserts'

  | Expr_access (e, dim) ->

    { expr with expr_desc = Expr_access (e', dim) }, l', eqs', asserts'

  | Expr_power (e, dim) ->

    { expr with expr_desc = Expr_power (e', dim) }, l', eqs', asserts'

  | Expr_pre e ->

    { expr with expr_desc = Expr_pre e' }, l', eqs', asserts'

  | Expr_when (e, id, label) ->

    { expr with expr_desc = Expr_when (e', id, label) }, l', eqs', asserts'

  | Expr_merge (id, branches) ->

    let el, l', eqs', asserts' = inline_tuple (List.map snd branches) in

    let branches' = List.map2 (fun (label, _) v -> label, v) branches el in

    { expr with expr_desc = Expr_merge (id, branches') }, l', eqs', asserts'

  let inline_expr = inline_expr ~selection_on_annotation:selection_on_annotation in

  let new_locals, eqs, asserts = 

    List.fold_left (fun (locals, eqs, asserts) eq ->

      let eq_rhs', locals', new_eqs', asserts' = 

      in

      locals', { eq with eq_rhs = eq_rhs' }::new_eqs'@eqs, asserts'@asserts

  in

    node_locals = new_locals;

    node_stmts = List.map (fun eq -> Eq eq) eqs;

    node_asserts = asserts;

  }

let inline_all_calls node nodes =

  let nd = match node.top_decl_desc with Node nd -> nd | _ -> assert false in

  in

  let main = [{ top_decl_desc = Node main_node; top_decl_loc = loc; top_decl_owner = filename; top_decl_itf = false }] in

  let new_prog = others@nodes_origs@nodes_inlined@main in

  let _ = Typing.type_prog type_env new_prog in

  let _ = Clock_calculus.clock_prog clock_env new_prog in