From 25cd60b2afaff595e710502df4f2980f589e01ea Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 29 Mar 2013 08:56:35 +0100
Subject: [PATCH] The -exec mode now supports array iterators (iterating on
memoryless node).
F**k! socExec.ml was not gitted!!!
---
src/lic2soc.ml | 47 ++++---
src/soc.ml | 16 ++-
src/socExec.ml | 271 +++++++++++++++++++++++++++++++++++++++
src/socExec.mli | 3 +
src/socExecEvalPredef.ml | 7 +-
src/socExecValue.ml | 49 ++++---
src/socPredef.ml | 26 ++--
src/socUtils.ml | 8 +-
test/lus2lic.sum | 2 +-
test/lus2lic.time | 4 +-
10 files changed, 369 insertions(+), 64 deletions(-)
create mode 100644 src/socExec.ml
create mode 100644 src/socExec.mli
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 01436b4b..70ef99eb 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/03/2013 (at 09:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/03/2013 (at 15:33) by Erwan Jahier> *)
open Lxm
open Lic
@@ -240,8 +240,7 @@ let build_step: Lxm.t -> string -> Lic.node_exp -> Soc.var list ->
Soc.lxm = lxm;
Soc.idx_ins = convert_node_interface node.Lic.inlist_eff;
Soc.idx_outs = convert_node_interface node.Lic.outlist_eff;
- Soc.impl =
- Some (locals, List.map gao_of_action actions)
+ Soc.impl = Soc.Gaol (locals, List.map gao_of_action actions)
}
let (lic_to_soc_var : Lic.var_info -> Soc.var) =
@@ -254,11 +253,14 @@ let soc_profile_of_node: Lic.node_exp -> Soc.var list * Soc.var list =
let outputs = List.map lic_to_soc_var n.Lic.outlist_eff in
inputs, outputs
+let (make_soc_key_of_node_exp : Lic.node_key -> Soc.var_type list -> Soc.key) =
+fun nk vl ->
+ LicDump.string_of_node_key_rec nk, vl, None
+
let (soc_key_of_node_exp : Lic.node_exp -> Soc.key) =
fun n ->
let svi,svo = soc_profile_of_node n in
- let (id, sargs) = n.node_key_eff in
- let sk = LicDump.string_of_node_key_rec n.node_key_eff, List.map snd (svi@svo), None in
+ let sk = make_soc_key_of_node_exp n.node_key_eff (List.map snd (svi@svo)) in
sk
(* XXX duplicated code with get_leaf *)
@@ -421,7 +423,7 @@ let by_pos_op_to_soc_ident = function
| ARRAY -> "Lustre::array"
| HAT _ -> "Lustre::hat"
| PREDEF_CALL n
- | CALL n -> string_of_node_key n.it
+ | CALL n -> LicDump.string_of_node_key_rec n.it
| _ -> assert false
@@ -515,7 +517,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
let res_type = get_exp_type lpl in
let full_profile = args_types @ res_type in
- let sk = id, full_profile, None in
+ let sk = make_soc_key_of_node_exp (("",id),[]) full_profile in
try Soc.SocMap.find sk soc_tbl
with Not_found ->
Verbose.exe ~flag:dbg (fun () ->
@@ -663,6 +665,8 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let io_list = node.Lic.inlist_eff @ node.Lic.outlist_eff in
let io_type = List.map (fun vi -> lic_to_soc_type vi.var_type_eff) io_list in
let soc_key = Ident.string_of_long2 (fst node.Lic.node_key_eff), io_type, None in
+
+ let soc_key = make_soc_key_of_node_exp node.Lic.node_key_eff io_type in
let lxm = node.Lic.lxm in
let ctx = create_context licprg in
let (soc_of_body: Lic.node_body -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
@@ -711,17 +715,30 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
fun nk soc_tbl ->
let iter_node,c = match List.sort compare (snd nk) with
| [ConstStaticArgLic(_,Int_const_eff(c)) ;
-(* TypeStaticArgLic(_); *)
+ (* TypeStaticArgLic(_); *)
NodeStaticArgLic(_,node_key)] ->
node_key,c
| _ -> assert false
in
let nsk, soc_tbl = process_node iter_node soc_tbl in
+ let nsoc = SocUtils.find lxm nsk soc_tbl in
+ let nsoc_step = match nsoc.step with [s] -> s
+ | _ -> assert false
+ (* hmm. Iterating on a pre will not work. XXX fixme ! *)
+ in
let soc = {
Soc.key = soc_key;
Soc.profile = soc_profile_of_node node;
- Soc.instances = [] ;
- Soc.step = [];
+ Soc.instances = nsoc.instances ; (* XXX create n x |nsoc.instances| instances! *)
+ Soc.step = [
+ {
+ name = "step";
+ lxm = nsoc_step.lxm;
+ idx_ins = nsoc_step.idx_ins;
+ idx_outs = nsoc_step.idx_outs;
+ impl = Iterator(snd (fst nk), nsk, int_of_string c);
+ }
+ ];
Soc.have_mem = None;
Soc.precedences = [];
}
@@ -731,13 +748,9 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let (soc_of_extern: Lic.node_exp -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun node soc_tbl ->
try
- let soc =
- SocPredef.of_soc_key soc_key
- in
- Some(ctx, soc, soc_tbl)
-
+ let soc = SocPredef.of_soc_key soc_key in
+ Some(ctx, soc, soc_tbl)
with e ->
-
let soc = {
Soc.key = soc_key;
Soc.profile = soc_profile_of_node node;
@@ -747,7 +760,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.precedences = [];
}
in
- (* Some(create_context licprg, soc) *)
+ (* Some(create_context licprg, soc) *)
print_string "Extern node not yet supported, sorry\n";
flush stdout;
assert false
diff --git a/src/soc.ml b/src/soc.ml
index 6fcbfe27..0c8bb6a9 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/03/2013 (at 09:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 15:24) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -39,19 +39,23 @@ let (var_type_of_var_expr : var_expr -> var_type) =
| Field(_, _,vt)
| Index(_,_,vt) -> vt
-
type atomic_operation =
| Assign (* Wire *)
| Method of instance * ident (* node step call ; the ident is the step name *)
| Procedure of key (* memoryless method made explicit (a good idea?) *)
-
(* Guarded Atomic Operation *)
type gao =
| Case of ident (* enum var *) * (ident (* enum value *) * gao list) list
| Call of var_expr list * atomic_operation * var_expr list
(* outputs * op * inputs *)
+type step_impl =
+ | Predef
+ | Gaol of var list * gao list (* local vars + body *)
+ | Iterator of string * key * int (* iterator, iterated soc key, size *)
+
+
type step_method = {
name : ident;
lxm : Lxm.t;
@@ -59,9 +63,9 @@ type step_method = {
variables nécessaires et puis c'est marre !!! *)
idx_ins : int list; (* input index in the profile *)
idx_outs : int list; (* output index in the profile *)
- impl : (var list * gao list) option; (* local vars + body ; None for predef op *)
-(* XXX Ã quoi sert cette liste de variables ??? (Parce que dans
- SocPredef, je ne sais pas trop quoi y mettre...) *)
+ impl : step_impl;
+(* impl : (var list * gao list) option; (* local vars + body ; None for predef op *) *)
+
}
type precedence = ident * ident list
diff --git a/src/socExec.ml b/src/socExec.ml
new file mode 100644
index 00000000..246a6846
--- /dev/null
+++ b/src/socExec.ml
@@ -0,0 +1,271 @@
+(* Time-stamp: <modified the 29/03/2013 (at 08:55) by Erwan Jahier> *)
+
+open Soc
+open SocExecValue
+
+
+let (assign_expr : ctx -> var_expr -> var_expr -> ctx) =
+ fun ctx ve_in ve_out ->
+ { ctx with s =
+ let v = SocExecValue.get_value ctx ve_in in
+ sadd_partial ctx.s ve_out ctx.cpath v
+ }
+
+
+(* [array_index i v] returns the var_expr v[i] *)
+let (array_index : int -> var -> var_expr) =
+ fun i (vn,vt) ->
+ let vt_elt =
+ match vt with
+ | Array(vt_elt,_) -> vt_elt
+ | _ -> assert false
+ in
+ Index(Var(vn,vt),i,vt_elt)
+
+let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
+ -> SocExecValue.ctx) =
+ fun step soc_tbl soc ctx ->
+ let soc_name,_,_ = soc.key in
+ match step.impl with
+ | Predef -> (
+ try SocExecEvalPredef.get soc.key ctx
+ with Not_found -> (* Not a predef op *)
+ print_string ("*** Error when executing " ^ soc_name ^
+ ". Is it defined in SocExecEvalPredef?\n"); flush stdout;
+ assert false
+ )
+ | Gaol(vl,gaol) -> List.fold_left (do_gao step.lxm soc_tbl) ctx gaol
+ | Iterator("map", node_sk, n) ->
+ let node_soc = SocUtils.find step.lxm node_sk soc_tbl in
+ let node_step = match node_soc.step with [step] -> step | _ -> assert false in
+ let iter_inputs,iter_outputs = soc.profile in
+ let node_inputs,node_outputs = node_soc.profile in
+ let node_step_in_vars = filter_params node_soc node_inputs node_step.idx_ins in
+ let node_step_out_vars = filter_params node_soc node_outputs node_step.idx_outs in
+ let path_save = ctx.cpath in
+ let rctx = ref ctx in
+ for i = 0 to n-1 do
+ let (proc_name,_,_) = node_soc.key in
+ (* XXX something else has to be done if the node has memories *)
+
+(* XXX appler do_step *)
+ rctx := { !rctx with cpath = proc_name::ctx.cpath };
+ let args_in : var_expr list = List.map (array_index i) iter_inputs in
+ let args_out : var_expr list = List.map (array_index i) iter_outputs in
+ let new_s = substitute_args_and_params args_in node_step_in_vars !rctx in
+ rctx := { !rctx with s=new_s };
+ rctx := soc_step node_step soc_tbl node_soc !rctx;
+ let s_out = substitute_params_and_args node_step_out_vars args_out !rctx in
+ rctx := { cpath=path_save; s = s_out };
+ done;
+ (* 4 DEBUG*) let str = string_of_substs !rctx.s in print_string ("ici3 \n"^str); flush stdout;
+ !rctx;
+ | Iterator(it, it_soc, n) -> assert false
+
+and (do_gao : Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx) =
+ fun lxm soc_tbl ctx gao ->
+ match gao with
+ | Case(id, id_gao_l) -> (
+ let id_val = get_enum id ctx in
+ let gaol = try List.assoc id_val id_gao_l with Not_found -> assert false in
+ List.fold_left (do_gao lxm soc_tbl) ctx gaol
+ )
+ | 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 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
+ )
+ | Call(vel_out, Method((inst_name,sk),step_name), vel_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
+ )
+and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
+ var_expr list -> var_expr list -> SocExecValue.ctx) =
+ fun name step ctx soc_tbl soc vel_in vel_out ->
+ let soc_in_vars, soc_out_vars = soc.profile in
+ let step_in_vars = filter_params soc soc_in_vars step.idx_ins in
+ let step_out_vars = filter_params soc soc_out_vars step.idx_outs in
+ 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 }
+
+
+(* 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 (
+ "\n*** Cannot get the " ^ (string_of_int (i+1)) ^
+ "th element of a list of size " ^ (string_of_int (List.length l))^"\n");
+ flush stdout;
+ assert false
+ in
+ let res = List.map (fun i -> local_nth i el) il in
+ res
+
+
+
+(* expand struct and arrays when communicating with the outside world (a good idea?) *)
+let rec (expand_profile:Soc.var list -> Soc.var list) =
+ fun vl ->
+ let res = List.flatten (List.map expand_var vl) in
+ (* fix point. now useless ? *)
+ if List.length res = List.length vl then res else
+ expand_profile res
+and expand_var var = match var with
+ | (vn,(Bool| Int | Real)) -> [var]
+ | (vn,Enum(n,l)) -> [vn,Int]
+ | (vn,Array(vt,i)) ->
+ let res = ref [] in
+ for k=i-1 downto 0 do
+ res := (vn^"_"^(string_of_int k),vt) :: !res;
+ done;
+ (expand_profile !res)
+ | (vn,Struct(name,fl)) ->
+ let res = List.map (fun (fn,t) -> vn^"_"^fn,t ) fl in
+ expand_profile res
+
+ | (vn,Extern id) -> assert false (* finish me! *)
+ | (vn,Alpha _) -> assert false (* should not occur *)
+
+let (int_to_enum : SocExecValue.t -> Soc.ident list -> SocExecValue.t) =
+ fun v el ->
+ match v with
+ | I i -> (try E (List.nth el i,i) with _ ->
+ failwith ("Enum out of the range [0,"^(string_of_int (List.length el))^"]"))
+ | _ -> assert false (* should not occur *)
+
+let rec (expand_subst: Rif_base.subst -> Rif_base.subst list) =
+ fun s ->
+ let rec aux acc (n,v) =
+ match v with
+ | U | I _ | F _ | B _ -> (n,v)::acc
+ | E(_e,i) -> (n,I i)::acc
+ | S fl ->
+ let f (fn,fv) = n^"_"^fn, fv in
+ let fl = List.map f fl in
+ List.fold_left aux acc fl
+ | A a ->
+ let res = ref acc in
+ for i=0 to (Array.length a)-1 do
+ let n_i = n^"_"^(string_of_int i) in
+ res := aux !res (n_i, a.(i));
+ done;
+ !res
+ in
+ aux [] s
+
+(* A local shortcut to ease the profile def *)
+type sl = Rif_base.subst list
+
+(* Reconstruct the flattenned data *)
+let (unexpand : sl -> Soc.var list -> sl) =
+ fun sl vl ->
+ let rec (aux : sl -> sl -> Soc.var list -> sl * sl)=
+ fun sl_done sl_todo vl ->
+ (* Returns the (accumulated) result and the unused subst
+ (which should be empty at the top-level call) *)
+ match sl_todo, vl with
+ | _,[] -> sl_done, sl_todo
+ | s::sl, (_, (Bool| Int | Real))::vl -> aux (s::sl_done) sl vl
+ | (id,v)::sl, (_,Enum(n,el))::vl ->
+ let s = (id, int_to_enum v el) in
+ aux (s::sl_done) sl vl
+
+ | _, (vn, Array(vt,i))::vl -> (
+ let sl_todo_ref = ref sl_todo in
+ let sl_done_ref = ref [] in
+ let a_fake_value = I 42 in
+ let res = Array.make i a_fake_value in
+ for k=0 to i-1 do
+ let (vk_l:Soc.var list) = [("fake_name",vt)] in
+ let (sl_done_v, sl_todo_v) = aux !sl_done_ref !sl_todo_ref vk_l in
+ sl_todo_ref:=sl_todo_v;
+ sl_done_ref:=sl_done_v;
+ Array.set res k (snd (List.hd !sl_done_ref));
+ done;
+ let sl_done = (vn, A res)::sl_done in
+ aux sl_done !sl_todo_ref vl
+ )
+ | _, (vn,Struct(sn,fl))::vl ->
+ let sl_todo, fl = List.fold_left aux_field (sl_todo,[]) fl in
+ let sl_done = (vn, S fl)::sl_done in
+ aux sl_done sl_todo vl
+
+
+ | _, (vn,Extern id)::_ -> assert false (* finish me! *)
+ | _, (vn,Alpha _ )::_ -> assert false (* should not occur *)
+ | [],_::_ -> assert false (* should not occur *)
+
+ and (aux_field : sl * (ident * SocExecValue.t) list -> ident * var_type
+ -> sl * (ident * SocExecValue.t) list ) =
+ fun (sl_todo, fl) (fn, t) ->
+ let new_sl_done, sl_todo = aux [] sl_todo [fn,t] in
+ let (_,v) = List.hd new_sl_done in
+ sl_todo, (fn,v)::fl
+
+ in
+ let res, remaining = aux [] sl vl in
+ assert (remaining=[]);
+ res
+
+let (read_soc_input : Soc.t -> out_channel -> substs -> substs) =
+ fun soc oc ctx_s ->
+ let profile = expand_profile (fst soc.profile) in
+ let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in
+ let s:Rif_base.subst list = Rif_base.read stdin (Some oc) vntl in
+ let s = unexpand s (fst soc.profile) in
+ List.fold_left (fun acc (id,v) -> sadd acc [id] v) ctx_s s
+
+let rec (loop_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> int -> out_channel -> unit) =
+ fun soc_tbl soc ctx step_nb oc ->
+ Rif_base.write oc ("\n#step " ^ (string_of_int step_nb)^"\n");
+ 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
+(* 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
+ let s = SocExecValue.filter_top_subst ctx.s in
+ let s = List.flatten(List.map expand_subst s) in
+ Rif_base.write oc " #outs ";
+ Rif_base.write_outputs oc vntl s;
+ Rif_base.flush oc;
+ loop_step soc_tbl soc ctx (step_nb+1) oc
+
+let (f : Soc.tbl -> Soc.key -> unit) =
+ fun soc_tbl sk ->
+ let soc = try SocMap.find sk soc_tbl with Not_found -> assert false in
+ let ctx = SocExecValue.create_ctx soc_tbl soc in
+ let vntl_of_profile = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) in
+ let vntl_i = vntl_of_profile (expand_profile (fst soc.profile)) in
+ let vntl_o = vntl_of_profile (expand_profile (snd soc.profile)) in
+ let oc =
+ if !Global.outfile = "" then stdout else
+ let rif_file =
+ try (Filename.chop_extension !Global.outfile) ^ ".rif"
+ with _ -> !Global.outfile ^ ".rif"
+ in
+ open_out rif_file
+ in
+ Verbose.dump_entete oc;
+ Rif_base.write_interface oc vntl_i vntl_o None None;
+ Rif_base.flush oc;
+ try loop_step soc_tbl soc ctx 1 oc
+ with Rif_base.Bye ->
+ close_out oc
diff --git a/src/socExec.mli b/src/socExec.mli
new file mode 100644
index 00000000..2ec03e2f
--- /dev/null
+++ b/src/socExec.mli
@@ -0,0 +1,3 @@
+(* Time-stamp: <modified the 14/03/2013 (at 16:43) by Erwan Jahier> *)
+
+val f : Soc.tbl -> Soc.key -> unit
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index b88571ed..4cb18adb 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 09:58) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/03/2013 (at 15:37) by Erwan Jahier> *)
open SocExecValue
open Soc
@@ -7,12 +7,13 @@ open Soc
let (lustre_plus : ctx -> ctx) =
fun ctx ->
+ let l = [get_val "x" ctx; get_val "y" ctx] in
let (vn,vv) =
- match [get_val "x" ctx; get_val "y" ctx] with
+ match l with
| [I x1; I x2] -> "z"::ctx.cpath,I(x1+x2)
| [F i1; F i2] -> "z"::ctx.cpath,F(i1+.i2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
- | _ -> assert false
+ | e -> assert false
in
{ ctx with s = sadd ctx.s vn vv }
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index 80e45acb..55394df2 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 08:35) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/03/2013 (at 17:39) by Erwan Jahier> *)
open Soc
@@ -54,9 +54,9 @@ let rec (get_access : Soc.var_expr -> access list) =
| Field(ve, n,_) -> (Fld n)::(get_access ve)
| Const(id,_) -> assert false
+(* Replace access(pre_v) by v in pre_v *)
let rec (update_val : t -> t -> access list -> t) =
fun pre_v v access ->
-(* Replace access(pre_v) by v in pre_v *)
match pre_v,access with
| _,[] -> v
| A a, (Idx i)::access ->
@@ -75,9 +75,9 @@ let (update_leaf : var_expr -> t -> t -> substs) =
let new_v = update_val pre_v v access in
Leaf(new_v)
+(* The same as update in the case where no previous value exists *)
let rec (create_val : Soc.var_type -> t -> access list -> t) =
fun vt v access ->
-(* The same as update in the case where no previous value exists *)
match vt,access with
| _,[] -> v
| Array(vt,size), (Idx i)::access ->
@@ -96,10 +96,23 @@ let (create_leaf : var_expr -> t -> substs) =
let new_v = create_val top_vt v access in
Leaf(new_v)
-(* should be able to replace sadd actually *)
+let rec (get_top_id : Soc.var_expr -> ident) =
+ function
+ | Var(id,_) | Const(id,_) -> id
+ | Field(ve, _, _) | Index(ve,_,_) -> get_top_id ve
+
+
+
+(* [sadd_partial ct ve path v] updates ct by associating ve::path to v in ct ;
+
+ nb : It is a more general version of sadd that does not only work on
+ var but on var_expr (which means that it can update an array element,
+ or a struct field, whereas sadd only updates variable.
+*)
let (sadd_partial : substs -> var_expr -> path -> t -> substs) =
fun ct ve x v ->
-(* update ct by associating x::ve to v in ct ; *)
+ let top_id = get_top_id ve in
+ let x = top_id::x in
let rec aux ct (x,v) =
match ct,x with
| Leaf(pre_v),[] -> update_leaf ve v pre_v
@@ -122,8 +135,9 @@ let (sadd_partial : substs -> var_expr -> path -> t -> substs) =
(* fun ct (x,v) -> *)
(* (x,v)::(List.remove_assoc x ct) *)
+(* [sadd ct x v] updates updates ct by associating x to v in ct *)
let (sadd : substs -> path -> t -> substs) =
- fun ct x v ->
+ fun ct x v ->
let rec aux ct (x,v) =
match ct,x with
| Leaf(_),[] -> Leaf(v)
@@ -325,28 +339,27 @@ let rec (get_value : ctx -> var_expr -> t) =
(* exported *)
-let (substitute_args_and_params : var_expr list -> var list -> ctx -> substs) =
+let (substitute_args_and_params : var_expr list -> var list -> ctx -> substs) =
fun args params ctx ->
assert (List.length args = List.length params);
let arg_ctx = { ctx with cpath = List.tl ctx.cpath } in
- let s = List.map2 (fun arg (pn,_) -> pn::ctx.cpath, get_value arg_ctx arg) args params in
- let s = List.fold_left (fun acc (vn,vv) -> sadd acc vn vv) ctx.s s in
- s
+ let s = List.fold_left2
+ (fun acc arg (pn,_) -> sadd acc (pn::ctx.cpath) (get_value arg_ctx arg))
+ ctx.s args params
+ in
+ s
let (substitute_params_and_args : var list -> var_expr list -> ctx -> substs) =
fun params args ctx ->
assert (List.length args = List.length params);
- let s = List.map2
- (fun arg par ->
- match arg,par with
- | Var(vn,_), (pn,_) -> vn::(List.tl ctx.cpath), get_val pn ctx
- | _,_ -> assert false
- )
- args params
+ let s = List.fold_left2
+ (fun acc arg (pn,_) -> sadd_partial acc arg (List.tl ctx.cpath) (get_val pn ctx) )
+ ctx.s args params
in
- let s = List.fold_left (fun acc (vn,vv) -> sadd acc vn vv) ctx.s s in
s
+
+
let empty_ctx: ctx = {
cpath = [];
s = Node [];
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 7b2bf49d..fac49b2f 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/03/2013 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 15:28) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -39,14 +39,14 @@ let step11 = { (* a useful alias again *)
lxm = Lxm.dummy "predef soc";
idx_ins = [0];
idx_outs = [0];
- impl = None;
+ impl = Predef;
}
let step21 impl = { (* a useful alias again *)
name = "step";
lxm = Lxm.dummy "predef soc";
idx_ins = [0;1];
idx_outs = [0];
- impl = impl;
+ impl = Predef;
}
(* used to build predef soc with no memory *)
@@ -123,14 +123,14 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [];
idx_outs = [0];
- impl = Some([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)])]);
+ impl = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)])]);
};
{
name = "set";
lxm = Lxm.dummy "predef soc";
idx_ins = [0];
idx_outs = [];
- impl = Some([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v1)])]);
+ impl = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v1)])]);
};
];
precedences = ["set", ["get"]];
@@ -151,7 +151,7 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [0;1];
idx_outs = [0];
- impl = Some([],[Call([Var(vout)],
+ impl = Gaol([],[Call([Var(vout)],
Procedure ("Lustre::if",[Bool;t;t;t],None),
[Var(pre_mem);Var(v1);Var(v2)])]);
};
@@ -160,7 +160,7 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [];
idx_outs = [-1];
- impl = Some([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
+ impl = Gaol([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
};
];
precedences = ["update_first_instant",["step"]];
@@ -190,7 +190,7 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [1];
idx_outs = [];
- impl = Some([pre_mem],[Call([pre_mem], Assign, [Var(v1)])]);;
+ impl = Gaol([pre_mem],[Call([pre_mem], Assign, [Var(v1)])]);;
have_mem = true;
};
];
@@ -216,7 +216,7 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [0; 1; 2];
idx_outs = [0];
- impl = None;
+ impl = Predef;
}
];
}
@@ -298,7 +298,7 @@ let make_slice_soc: Lic.slice_info -> Soc.var_type -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [0];
idx_outs = [0];
- impl = None;
+ impl = Predef;
};
];
precedences = [];
@@ -335,7 +335,7 @@ let make_array_soc: int -> Soc.var_type -> Soc.t =
lxm = Lxm.dummy "predef array soc";
idx_ins = gen_index_list i;
idx_outs = [0];
- impl = None;
+ impl = Predef;
};
];
precedences = [];
@@ -356,7 +356,7 @@ let make_array_concat_soc: int -> int -> Soc.var_type -> Soc.t =
lxm = Lxm.dummy "predef array concat soc";
idx_ins = [0;1];
idx_outs = [0];
- impl = None;
+ impl = Predef;
};
];
precedences = [];
@@ -381,7 +381,7 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t =
lxm = Lxm.dummy "predef hat soc";
idx_ins = [0];
idx_outs = [0];
- impl = None;
+ impl = Predef;
};
];
precedences = [];
diff --git a/src/socUtils.ml b/src/socUtils.ml
index 5336267f..4d079aca 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/03/2013 (at 17:51) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/03/2013 (at 15:26) by Erwan Jahier> *)
open Soc
@@ -174,9 +174,9 @@ let string_of_method_ff: (Soc.t -> step_method -> Format.formatter -> unit) = fu
string_interface_of_method_ff c m ff;
match m.impl with
- | None -> fprintf ff "@]@]"
- | Some i ->
- let locals, gaos = i in
+ | Predef -> fprintf ff "@]@]"
+ | Iterator _ -> assert false (* todo *)
+ | Gaol (locals, gaos) ->
fprintf ff ": {@;";
fprintf ff "@[<v>-- locals vars@;";
List.iter (
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 7b7da54d..0276af02 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Wed Mar 27 09:50:22 2013
+Test Run By jahier on Thu Mar 28 18:08:46 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 0a65f1e7..78b14b72 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 26 seconds
-testcase ./lus2lic.tests/progression.exp completed in 1 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 29 seconds
+testcase ./lus2lic.tests/progression.exp completed in 0 seconds
--
GitLab