Soc2c: fix the behavior of the arrow soc.

The arrow soc now has a memory used to hold if the first step has be triggered.

src/soc2c.ml

-(* Time-stamp: <modified the 19/06/2014 (at 10:44) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 11:33) by Erwan Jahier> *)
 
 
 (* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
@@ -78,7 +78,7 @@ let rec (string_of_var_expr: Soc.t -> Soc.var_expr -> string) =
     | Const("true", _) -> "_true"
     | Const("false", _) -> "_false"
     | Const(id, _) -> id2s id
-    | Var ("mem_pre",_)   -> (* Clutch! it's not an interface var... *) "ctx->mem_pre" 
+    | Var ("_memory",_)   -> (* Clutch! it's not an interface var... *) "ctx->_memory" 
     | Var (id,_)   -> 
       if not (mem_interface soc id) then id2s id 
       else if is_memory_less soc then
@@ -260,7 +260,7 @@ let (typedef_of_soc : Soc.t -> string) =
       (match soc.have_mem with
         | None -> ""
         | Some t -> 
-          Printf.sprintf "   /*Memory cell*/\n   %s ;\n" (id2s (type_to_string t "mem_pre"))
+          Printf.sprintf "   /*Memory cell*/\n   %s ;\n" (id2s (type_to_string t "_memory"))
       )
     in
     let str =  str ^ (if soc.instances <> [] then  "   /*INSTANCES*/\n" else "") in

src/socExec.ml

-(* Time-stamp: <modified the 17/06/2014 (at 10:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 14:32) by Erwan Jahier> *)
 
 open Soc
 open Data
@@ -65,7 +65,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
         let inst_name =
           match soc.instances with
             | [] -> let (proc_name,_,_) = node_soc.key in proc_name
-            | [inst]  -> fst inst
+            | [inst] -> fst inst
             | _ -> assert false
         in
         let path_saved = ctx.cpath in
@@ -78,7 +78,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
           else
             let first_step = Var ("$first_step",Bool) in
             let v = get_value ctx first_step in
-            if v = B true then
+            if v = U ||  v = B true then
               (* We are on the first step of node_soc;
                  - we assign the output var to the default values *)
               let ctx =  { ctx with cpath=path_saved } in
@@ -88,6 +88,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
                  and the output will keep their previous value. *) 
               { ctx with cpath=path_saved }
         in
+        let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
         ctx
       )
       | Iterator(iter, node_sk, n) -> 
@@ -122,7 +123,6 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
           rctx := assign_expr !rctx a_in a_out);  (* a_out=a_n *)
         !rctx;
     in
-    let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
     ctx
 
 and (do_gao :  Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx) =

src/socExecEvalPredef.ml

-(* Time-stamp: <modified the 26/03/2014 (at 09:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 14:16) by Erwan Jahier> *)
 
 open SocExecValue
 open Data
@@ -318,12 +318,14 @@ let lustre_current ctx =
 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}]) 
+            get_val "_memory" { 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 ctx = { ctx with s = sadd ctx.s vn vv } in
+  let ctx = { ctx with s = sadd ctx.s ("_memory"::ctx.cpath) (B false) } in
+  ctx
 
 let lustre_hat tl ctx =
   let i = match tl with

src/socExecValue.ml

-(* Time-stamp: <modified the 16/06/2014 (at 17:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 14:31) by Erwan Jahier> *)
 
 let dbg = (Verbose.get_flag "exec")
 
@@ -225,13 +225,12 @@ let (get_val : ident -> ctx -> Data.v) =
     in
     try find ctx.s (List.rev (id::ctx.cpath))
     with Not_found -> 
-      if id = "$first_step" then Data.B true else (
       Verbose.exe ~flag:dbg (fun () ->
         let msg = "Warning " ^(path_to_string (id::ctx.cpath)) ^ " unbound in \n" 
           ^ (string_of_substs ctx.s) 
         in
         print_string msg; flush stdout);
-      U)
+      U
 
 let (get_enum : ident -> ctx -> ident) =
 fun id ctx -> 

src/socPredef.ml

-(* Time-stamp: <modified the 02/06/2014 (at 09:32) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 11:43) by Erwan Jahier> *)
 
 (** Synchronous Object Code for Predefined operators. *)
 
@@ -68,6 +68,8 @@ let first_step = Var("$first_step", Bool)
 
 let (get_mem_name : Soc.key -> Data.t -> string) =
   fun (k,tl,_) vt -> 
+    "_memory"
+(*
     match Str.split (Str.regexp "::") k with        
       | ["Lustre";op] -> (
         match op.[0] with
@@ -75,7 +77,7 @@ let (get_mem_name : Soc.key -> Data.t -> string) =
           | _ ->  "mem_"^op
       )
       | _ ->  "mem_"^k
-
+*)
 
 let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t = 
   fun init sk -> 
@@ -226,7 +228,7 @@ let of_soc_key : Soc.key -> Soc.t =
             }
           ];
           precedences   = [];
-          have_mem = None;
+          have_mem = Some Bool;
         }
       | "Lustre::if"  ->  {
         key      = sk;

src/socPredef2c.ml

-(* Time-stamp: <modified the 18/06/2014 (at 18:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 19/06/2014 (at 11:34) by Erwan Jahier> *)
 
 open Data
 open Soc
@@ -28,10 +28,12 @@ let (lustre_impl : Soc.key -> string) =
 
 let (lustre_arrow : Soc.key -> string) =
   fun sk -> 
-    let ctx = get_ctx_name sk in
-    let x,y,z = ctx^".x", ctx^".y", ctx^".z" in
-    Printf.sprintf"  %s = (first_step)? %s : %s;\n" z x y
-
+(*     let ctx = get_ctx_name sk in *)
+(*     let x,y,z = ctx^".x", ctx^".y", ctx^".z" in *)
+    let x,y,z = "ctx->x", "ctx->y", "ctx->z" in
+    (Printf.sprintf"  %s = (ctx->_memory)? %s : %s;\n" z x y) ^
+      ("  ctx->_memory = _false;\n")
+      
 let (lustre_merge : Soc.key -> string) =
   fun sk -> 
     let ctx = get_ctx_name sk in

test/lus2lic.sum

-Test Run By jahier on Thu Jun 19 10:58:46 2014
+Test Run By jahier on Thu Jun 19 14:32:33 2014
 Native configuration is i686-pc-linux-gnu
 
 		=== lus2lic tests ===
@@ -1483,5 +1483,5 @@ XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/seman
 # of unexpected failures	149
 # of unexpected successes	21
 # of expected failures		37
-testcase ./lus2lic.tests/non-reg.exp completed in 143 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 130 seconds
 testcase ./lus2lic.tests/progression.exp completed in 0 seconds

test/lus2lic.time

-testcase ./lus2lic.tests/non-reg.exp completed in 143 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 130 seconds
 testcase ./lus2lic.tests/progression.exp completed in 0 seconds