CristalCaveGem » LustreC

let rec add_expr_reset_cond cond expr =

  let aux = add_expr_reset_cond cond in

  let new_desc = 

    match expr.expr_desc with

    | Expr_const _

    | Expr_ident _ -> expr.expr_desc

    | Expr_tuple el -> Expr_tuple (List.map aux el)

    | Expr_ite (c, t, e) -> Expr_ite (aux c, aux t, aux e)

    | Expr_arrow (e1, e2) -> 

      (* we replace the expression e1 -> e2 by e1 -> (if cond then e1 else e2) *)

      let e1 = aux e1 and e2 = aux e2 in

      (* inlining is performed before typing. we can leave the fields free *)

      let new_e2 = mkexpr expr.expr_loc (Expr_ite (cond, e1, e2)) in

      Expr_arrow (e1, new_e2) 

    | Expr_fby _ -> assert false (* TODO: deal with fby. This hasn't been much handled yet *)

    | Expr_array el -> Expr_array (List.map aux el)

    | Expr_access (e, dim) -> Expr_access (aux e, dim)

    | Expr_power (e, dim) -> Expr_power (aux e, dim)

    | Expr_pre e -> Expr_pre (aux e)

    | Expr_when (e, id, l) -> Expr_when (aux e, id, l)

    | Expr_merge (id, cases) -> Expr_merge (id, List.map (fun (l,e) -> l, aux e) cases)

    | Expr_appl (id, args, reset_opt) -> 

      (* we "add" cond to the reset field. *)

      let new_reset = match reset_opt with

	  None -> cond

	| Some cond' -> mkpredef_call cond'.expr_loc "||" [cond; cond']

      in

      Expr_appl (id, args, Some new_reset)

  in

  { expr with expr_desc = new_desc }

let add_eq_reset_cond cond eq =

  { eq with eq_rhs = add_expr_reset_cond cond eq.eq_rhs }

(** [inline_call node loc uid args reset locals caller] returns a tuple (expr,

    locals, eqs, asserts)    

*)

let inline_call node loc uid args reset locals caller =

      (*

	(try

	Format.eprintf "Inliner.inline_call unify %a %a@." Types.print_ty vdecl.var_type Dimension.pp_dimension (List.assoc v.var_id static_inputs);

	Typing.unify vdecl.var_type (Type_predef.type_static (List.assoc v.var_id static_inputs) (Types.new_var ()))

	with Not_found -> ());

	(try

	Clock_calculus.unify vdecl.var_clock (Clock_predef.ck_carrier (List.assoc v.var_id carrier_inputs) (Clocks.new_var true))

	with Not_found -> ());

      (*Format.eprintf "Inliner.inline_call res=%a@." Printers.pp_var vdecl;*)

      *)

  (*Format.eprintf "Inliner.rename_var %a@." Printers.pp_var v;*)

    (List.map (fun (vdecl, arg) -> let vdecl' = rename_var vdecl in { vdecl' with var_dec_value = Some (Corelang.expr_of_dimension arg) }) static_inputs)

  in

  (* Expressing reset locally in equations *)

  let eqs_r' =

    match reset with

      None -> eqs'

    | Some cond -> List.map (add_eq_reset_cond cond) eqs'

  in

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

                                expr_of_expr_list args.expr_loc (List.map snd dynamic_inputs)) in

	})

  assign_inputs::eqs_r',

	inline_call called' expr.expr_loc expr.expr_tag args' reset locals' node in