The -exec mode now supports the arrow statement in a simpler manner.

Now the arrow in handled as a predef statement; in order to know
if we are at the first step of a node, we do as for condact and
store the value of the first_step var in the current ctx.

src/lic2soc.ml

-(** Time-stamp: <modified the 05/04/2013 (at 18:21) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 10:30) by Erwan Jahier> *)
  
 open Lxm
 open Lic
@@ -361,11 +361,6 @@ let (action_of_step : Lxm.t -> Soc.t -> Lic.clock -> Soc.var_expr list ->
       Soc.var_expr list -> Soc.instance option -> Soc.step_method -> action) =
   fun lxm c clk il ol mem step ->
     let local_nth i l = 
-      if i < 0 then 
-        (* to handle the particular case of arrow. XXX just a crutch to make it works *)
-        let mem_name = SocPredef.get_mem_name c.Soc.key Soc.Bool in
-        Soc.Var(mem_name, Soc.Bool)
-      else
       try List.nth l i 
       with _ -> 
         print_string (
@@ -681,18 +676,6 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
                 );
                 let soc_tbl = SocMap.add soc.key soc soc_tbl in
                 let t = List.hd types in
-                (* The arrow is translated into a if. So we make sure that the "if"
-                   is in the soc tbl *)
-                let if_sk =  "Lustre::if", [Bool;t;t], None in
-                let soc_tbl =
-                  if pos_op = Lic.ARROW && not(SocMap.mem if_sk soc_tbl) then
-                    let soc = SocPredef.soc_interface_of_pos_op lxm
-                      (Lic.PREDEF_CALL ({ it=("Lustre","if"),[]; src=lxm})) [Bool;t;t]
-                    in
-                    SocMap.add soc.key soc soc_tbl
-                  else
-                    soc_tbl
-                in
                 snd (process_node nk soc_tbl)
               )
               | Undef_merge_soc (sk, lxm, clk, case_l) -> (

src/soc.ml

-(* Time-stamp: <modified the 05/04/2013 (at 14:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:30) by Erwan Jahier> *)
 
 (** Synchronous Object Component *)
 
@@ -88,7 +88,7 @@ type t = {
                                   the partial order defined in precedences *)
   precedences : precedence list; (* partial order over step methods *)
   have_mem : (var_type * var_expr option) option; 
-    (* Do this soc have a memory (pre, fby, arrow) + its type + default value *)
+    (* Do this soc have a memory (pre, fby) + its type + default value *)
 }
 
 (* SocKeyMap ? *)

src/socExec.ml

-(* Time-stamp: <modified the 05/04/2013 (at 18:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
 
 open Soc
 open SocExecValue
@@ -9,7 +9,7 @@ let (assign_expr : ctx -> var_expr -> var_expr -> ctx) =
   fun ctx ve_in ve_out -> (* ve_out := ve_in (in ctx) *)
     Verbose.exe ~flag:dbg 
       (fun () -> print_string ("Assigning "^(SocUtils.string_of_filter ve_out) ^
-                                  "to " ^(SocUtils.string_of_filter ve_in) ^ "\n"); flush stdout);
+                                  " to " ^(SocUtils.string_of_filter ve_in) ^ "\n"); flush stdout);
     { ctx with s =
         let v = SocExecValue.get_value ctx ve_in in
         sadd_partial ctx.s ve_out ctx.cpath v 
@@ -38,6 +38,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
       )
       | Gaol(vl,gaol) -> List.fold_left (do_gao step.lxm soc_tbl) ctx gaol
       | Boolred(i,j,k) -> (
+        (* XXX mettre ce code dans socPredef ? (ou socMetaopPredef)*)
         let inputs, outputs = soc.profile in
         let b_array = (List.hd inputs) in
         let cpt = ref 0 in
@@ -54,7 +55,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
       | Condact(node_sk, dft_cst) -> (
         let clk = SocExecValue.get_value ctx (Var ("i0",Bool)) in
         let vel_in, vel_out = soc.profile in
-        let vel_in =  List.map (fun x -> Var x) (List.tl vel_in) in
+        let vel_in  =  List.map (fun x -> Var x) (List.tl vel_in) in
         let vel_out =  List.map (fun x -> Var x) vel_out in        
         let node_soc = SocUtils.find step.lxm node_sk soc_tbl in
         let inst_name =
@@ -65,24 +66,22 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
         in
         let path_saved = ctx.cpath in
         let ctx = { ctx with cpath=inst_name::ctx.cpath } in
-        let ctx = 
+        let ctx =
         if clk = B true then
-          let node_step = match node_soc.step with [step] -> step | _ ->  assert false in
-          let ctx =  { ctx with s = sadd ctx.s ("first_step"::ctx.cpath) (B false) } in
+          let node_step = match node_soc.step with [step] -> step | _ -> assert false in
+          let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
           let ctx = do_step inst_name node_step ctx soc_tbl node_soc vel_in vel_out in
             { ctx with cpath=path_saved }
         else
-          let first_step = Var ("first_step",Bool) in
+          let first_step = Var ("$first_step",Bool) in
           let v = get_value ctx first_step in
           if v <> U then
               (* We are not on the first step of node_soc; hence we do nothing 
-                 and the output will keep their previous value.
-              *) 
+                 and the output will keep their previous value. *) 
               { ctx with cpath=path_saved }
           else
               (* We are on the first step of node_soc;
-                 - we assign the output var to the default values
-              *)
+                 - we assign the output var to the default values *)
             let ctx =  { ctx with cpath=path_saved } in
             List.fold_left2 assign_expr ctx dft_cst vel_out
         in
@@ -112,6 +111,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
               | _ -> assert false (* should not occur *)
           in
           rctx := do_step inst_name.(i) node_step !rctx soc_tbl node_soc vel_in vel_out;
+          rctx := { !rctx with cpath = List.tl !rctx.cpath };
         done;
         if iter <> "map" then (
           let a_in = Var (List.hd iter_inputs) in
@@ -132,18 +132,25 @@ and (do_gao :  Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx)
       | Call(vel_out, Assign, vel_in) -> List.fold_left2 assign_expr ctx vel_in vel_out
       | Call(vel_out, Procedure sk, vel_in) -> (
         let (proc_name,_,_) = sk in
+        let path_saved = ctx.cpath in
         let ctx = { ctx with cpath = proc_name::ctx.cpath } in
         let soc = SocUtils.find lxm sk soc_tbl in
         let step = match soc.step with [step] -> step | _ ->  assert false in
-        do_step proc_name step ctx soc_tbl soc vel_in vel_out 
+        let ctx = do_step proc_name step ctx soc_tbl soc vel_in vel_out in
+        { ctx with cpath = path_saved } 
       )
       | Call(vel_out, Method((inst_name,sk),step_name), vel_in) -> (
+        let path_saved = ctx.cpath in
         let ctx = { ctx with cpath = inst_name::ctx.cpath } in
         let soc = SocUtils.find lxm sk soc_tbl in
         let step = try List.find (fun sm -> sm.name = step_name) soc.step
           with Not_found -> assert false
         in
-        do_step inst_name step ctx soc_tbl soc vel_in vel_out
+        let ctx = do_step inst_name step ctx soc_tbl soc vel_in vel_out in
+        let ctx = { s = sadd ctx.s ("$first_step"::ctx.cpath) (B false);
+                    cpath = path_saved } 
+        in
+        ctx
       )
 and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t -> 
      var_expr list -> var_expr list -> SocExecValue.ctx) =
@@ -154,18 +161,12 @@ and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
     let new_s = substitute_args_and_params vel_in step_in_vars ctx in
     let ctx = soc_step step soc_tbl soc { ctx with s=new_s } in
     let s_out = substitute_params_and_args step_out_vars vel_out ctx in
-    { s = s_out ; cpath = List.tl ctx.cpath }
-
+    { ctx with s = s_out }
 
 (* get the step params from its soc params *)
 and (filter_params : Soc.t -> Soc.var list -> int list -> Soc.var list) =
   fun soc el il ->
     let local_nth i l = 
-      if i < 0 then 
-        (* to handle the particular case of arrow. XXX just a crutch to make it works *)
-        let mem_name = SocPredef.get_mem_name soc.Soc.key Soc.Bool in
-        (mem_name, Soc.Bool)
-      else
         try List.nth l i 
         with _ ->
           print_string (
@@ -290,6 +291,7 @@ let rec (loop_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> int -> out_channel
     let ctx = { ctx with s = read_soc_input soc oc ctx.s } in
     let step = match soc.step with [step] -> step | _ ->  assert false in
     let ctx = soc_step step soc_tbl soc ctx in
+    let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false)} in
 (*     dump_substs  ctx.s; *)
     let profile = expand_profile (snd soc.profile) in
     let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in

src/socExecEvalPredef.ml

-(* Time-stamp: <modified the 05/04/2013 (at 10:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
 
 open SocExecValue
 open Soc
@@ -246,6 +246,17 @@ let lustre_current ctx =
   in
   { ctx with s = sadd ctx.s vn vv }
 
+let lustre_arrow ctx =
+  let (vn,vv) = 
+    match ([get_val "x" ctx; get_val "y" ctx;
+            get_val "$first_step" { ctx with cpath=List.tl ctx.cpath}]) 
+    with
+      | [v1;v2; fs]  -> "z"::ctx.cpath, if fs=B false then v2 else v1
+      | _  -> assert false
+  in
+  { ctx with s = sadd ctx.s vn vv }
+
+
 let lustre_hat tl ctx =
   let i = match tl with
     | [_;Soc.Array(_,i)] -> i
@@ -293,6 +304,7 @@ let (get: Soc.key -> (ctx -> ctx)) =
     | "Lustre::array" -> lustre_array tl
     | "Lustre::concat" -> lustre_concat
 
+    | "Lustre::arrow" -> lustre_arrow
     | "Lustre::current" -> lustre_current
     | "Lustre::merge" -> lustre_merge tl
 

src/socPredef.ml

-(* Time-stamp: <modified the 05/04/2013 (at 13:30) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:43) by Erwan Jahier> *)
 
 (** Synchronous Object Code for Predefined operators. *)
 
@@ -168,10 +168,6 @@ let of_soc_key : Soc.key -> Soc.t =
         }
       | "Lustre::arrow"  ->  
         let prof = sp tl in
-        let v1,v2,vout = match prof with ([v1;v2],[vout]) -> v1,v2,vout | _ -> assert false in
-        let _,tl,_ = sk in
-        let t = List.hd tl in
-        let pre_mem:var = (get_mem_name sk Bool, Bool) in
         {
           key      = sk;
           profile  = prof;
@@ -182,59 +178,13 @@ let of_soc_key : Soc.key -> Soc.t =
               lxm     = Lxm.dummy "predef soc";
               idx_ins  = [0;1];
               idx_outs = [0];
-              impl    = Gaol([],[Call([Var(vout)], 
-                                      Procedure ("Lustre::if",[Bool;t;t;t],None),
-                                      [Var(pre_mem);Var(v1);Var(v2)])]);
-            };
-            {
-              name    = "update_first_instant";
-              lxm     = Lxm.dummy "predef soc";
-              idx_ins  = [];
-              idx_outs = [-1];
-              impl    = Gaol([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
-            };
+              impl    = Predef;
+            }
           ];
-          precedences   = ["update_first_instant",["step"]];
-          have_mem = Some (Bool, Some (Const("true",Bool)));
+          precedences   = [];
+          have_mem = None;
         }
       | "Lustre::fby"  -> assert false
-(* replace fby by '->' + 'pre' ?
-        let _,tl,_ = sk in
-        let t = List.hd tl in
-        let pre_mem:var = (get_mem_name sk t, t) in
-        let fi_mem:var = pre_mem^"_fi"
-        let prof = sp tl in
-        let v1,v2,vout = match prof with ([v1;v2],[vout]) -> v1,v2,vout | _ -> assert false in
-        {
-          key      = sk;
-          profile  = (sp tl);
-          instances = [];
-          step  = [
-            {
-              name    = "get";
-              lxm     = Lxm.dummy "predef soc";
-              idx_ins  = [];
-              idx_outs = [0];
-              impl    = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)])]);
-            };
-            {
-              name    = "set";
-              lxm     = Lxm.dummy "predef soc";
-              idx_ins  = [1];
-              idx_outs = [];
-              impl    = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v1)])]);
-            };
-            {
-              name    = "update_first_instant";
-              lxm     = Lxm.dummy "predef soc";
-              idx_ins  = [];
-              idx_outs = [-1];
-              impl    = Gaol([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
-            };
-          ];
-          precedences   = ["set", ["get"];"update_first_instant",["set"]];
-          have_mem = Some (Bool, Some (Const("true",Bool)));
-        }  *)
       | "Lustre::if"  ->  {
         key      = sk;
         profile  = (sp tl);
@@ -560,7 +510,7 @@ let (soc_interface_of_pos_op:
 
 (* 
 21/02/2013 : ai-je vraiment besoin de ca maintenant que les metaop ont t encapsul
-dans des noeuds ? bon, je garde quelque temps en commentaire au cas ou...
+   dans des noeuds ? bon, je garde quelque temps en commentaire au cas ou...
       | Lic.Fill(node,size), _ 
       | Lic.FillRed(node,size), _ 
       | Lic.Red(node,size), _ -> 

todo.org

@@ -38,7 +38,6 @@ que de lancer luciole
 En fait il me suffirait de m'inspirer de ce que j'ai fait dans le condact
 avec la variable "first_instant" !!!
 
-
 ** TODO Translate the fby properly into a soc 
    - State "TODO"       from ""           [2013-04-04 Thu 17:10]
 vs "-> pre" as it is done actually in file:~/lus2lic/src/ast2lic.ml::468