CristalCaveGem » LustreC

  | Carrow (ck1,ck2) ->

      {ck with cdesc =

       Carrow (subst_ck ck_substs var_substs ck1,

               subst_ck ck_substs var_substs ck2)}

      {ck with cdesc =

       Ctuple (List.map (subst_ck ck_substs var_substs) cklist)}

  | Con (ck',c) ->

      {ck with cdesc =

       Con (subst_ck ck_substs var_substs ck',c)}

  | Connot (ck',c) ->

      {ck with cdesc =

       Connot (subst_ck ck_substs var_substs ck',c)}

  | Pck_up (ck',k) ->

      {ck with cdesc = 

       Pck_up (subst_ck ck_substs var_substs ck', k)}

  | Pck_down (ck',k) ->

      {ck with cdesc = 

       Pck_down (subst_ck ck_substs var_substs ck', k)}

  | Pck_phase (ck',q) ->

      {ck with cdesc = 

       Pck_phase (subst_ck ck_substs var_substs ck', q)}

      ck

  | Cvar _ | Cunivar _ ->

      begin

        try Hashtbl.find ck_substs ck with Not_found -> ck

      end

      subst_ck ck_substs var_substs ck'

  | Ccarrying (_,ck') ->

      subst_ck ck_substs var_substs ck'

(* [new_expr_instance ck_substs var_substs e edesc] returns a new

   "instance" of expressions [e] of expression [e], where [edesc] is the

   expanded version of [e]. *)

  {expr_tag = Utils.new_tag ();

   expr_desc = edesc;

   expr_type = e.expr_type;

   expr_clock = subst_ck ck_substs var_substs e.expr_clock;

   expr_delay = Delay.new_var ();

   expr_loc = e.expr_loc;

   expr_annot = e.expr_annot}

  let vid = "_"^(string_of_int !locals_cpt) in

  locals_cpt := !locals_cpt+1;

  let ty_dec = {ty_dec_desc = Tydec_any; ty_dec_loc = vloc} in (* dummy *)

  let ck_dec = {ck_dec_desc = Ckdec_any; ck_dec_loc = vloc} in (* dummy *)

  {var_id = vid;

   var_orig = false;

   var_dec_type = ty_dec;

   var_dec_clock = ck_dec;

   var_dec_deadline = vdd;

   var_type = vtyp;

   var_clock = vck;

   var_loc = vloc}

  {expr_tag = Utils.new_tag ();

   expr_desc = Expr_ident v.var_id;

   expr_type = v.var_type;

   expr_clock = v.var_clock;

   expr_delay = Delay.new_var ();

   expr_loc = v.var_loc;

   expr_annot = None}

(* [build_ck_substs ck for_ck] computes the variable substitutions

   corresponding to the substitution of [ck] for [for_ck] *)

        List.iter2 aux cklist1 cklist2

        Hashtbl.add substs for_ck ck

    | _,_ ->

        ()

    (fun e (eqs,locs,elist) ->

      let eqs',locs',e' = expand_expr ck_substs var_substs e in

      eqs'@eqs,locs'@locs,e'::elist)

    elist ([],[],[])

    expand_expr parent_ck_substs parent_vsubsts args in

  let for_ck_ins,_ = Clocks.split_arrow nd.node_clock in

  (* Compute variable substitutions to apply inside node's body, due

     to the transformation of node variables into local variables of the

     main node. *)

  (* Add an equation in=arg for each node input + transform node input

     into a local variable of the main node *)

             new_local i.var_type i.var_clock i.var_dec_deadline i.var_loc in

           {eq_lhs = [i'.var_id];

            eq_rhs = e;

            eq_loc = i.var_loc}, i')

  (* Transform node local variables into local variables of the main

     node *)

        let v' = new_local v.var_type v.var_clock v.var_dec_deadline v.var_loc in

  in  

        let o' = new_local o.var_type o.var_clock o.var_dec_deadline o.var_loc in

  in  

  args_eqs@eq_ins@new_eqs,

  args_locs@loc_ins@loc_outs@loc_sub@new_locals,

  eout

      [],[],new_expr_instance ck_substs var_substs expr expr.expr_desc

      let id' = subst_var var_substs id in

      let edesc = Expr_ident id' in

      [],[],new_expr_instance ck_substs var_substs expr edesc

      let new_eqs,new_locals,exp_elist =

        expand_list ck_substs var_substs elist in

      new_eqs, new_locals,

      new_expr_instance ck_substs var_substs expr (Expr_tuple exp_elist)

  | Expr_fby (cst,e) ->

      let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_fby (cst, e') in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_concat (cst,e) ->

      let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_concat (cst, e') in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

      let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_tail e' in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_when (e,c) ->

      let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_when (e',c) in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_whennot (e,c) ->

      let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_whennot (e',c) in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_merge (c,e1,e2) ->

      let new_eqs1,new_locals1, e1' = expand_expr ck_substs var_substs e1 in

      let new_eqs2,new_locals2, e2' = expand_expr ck_substs var_substs e2 in

      let edesc = Expr_merge (c,e1',e2') in

      new_eqs1@new_eqs2,

      new_locals1@new_locals2,

      new_expr_instance ck_substs var_substs expr edesc

  | Expr_appl (id, e, r) ->

      let decl = Hashtbl.find node_table id in

      begin

        match decl.top_decl_desc with

        | ImportedNode _ ->

            let new_eqs,new_locals, e' = expand_expr ck_substs var_substs e in

            let edesc = Expr_appl (id, e', r) in

            new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

        | Node nd ->

            let new_eqs, new_locals, outs =

              expand_nodeinst ck_substs var_substs nd e in

            new_eqs, new_locals, new_expr_instance ck_substs var_substs expr outs

        | Include _ | Consts _ | SensorDecl _ | ActuatorDecl _ -> failwith "Internal error expand_expr"

      end

  | Expr_uclock (e,k) ->

      let new_eqs, new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_uclock (e',k) in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_dclock (e,k) ->

      let edesc = Expr_dclock (e',k) in

  | Expr_phclock (e,q) ->

      let new_eqs, new_locals, e' = expand_expr ck_substs var_substs e in

      let edesc = Expr_phclock (e',q) in

      new_eqs, new_locals, new_expr_instance ck_substs var_substs expr edesc

  | Expr_pre _ | Expr_arrow _ -> assert false (* Not used in the Prelude part of the code *)

  let eq' = {eq_lhs = lhs'; eq_rhs = expr; eq_loc = eq.eq_loc} in

    (fun (acc_eqs,acc_locals) eq ->

      (eq'::(new_eqs@acc_eqs)), (new_locals@acc_locals))

    ([],[]) eqs

(* Expands the body of a node, replacing recursively all the node calls

   it contains by the body of the corresponding node. *)

    expand_eqs (Hashtbl.create 10) (Hashtbl.create 10) nd.node_eqs in

  {node_id = nd.node_id;

   node_type = nd.node_type;

   node_clock = nd.node_clock;

   node_inputs = nd.node_inputs;

   node_outputs = nd.node_outputs;

   node_locals = new_locals@nd.node_locals;

   node_asserts = nd.node_asserts;

   node_eqs = new_eqs;

   node_spec = nd.node_spec;

   node_annot = nd.node_annot}

  if !Options.main_node = "" then

    raise (Corelang.Error No_main_specified);

    try

      Hashtbl.find node_table !Options.main_node

    with Not_found ->

      raise (Corelang.Error Main_not_found)

      raise (Corelang.Error Main_wrong_kind)

      expand_node nd