diff --git a/_oasis b/_oasis
index 8f43809c9f7196806e6f150a97bd46d6683d62df..e62fb321a6c4d0cfb3248931fc9881a261536334 100644
--- a/_oasis
+++ b/_oasis
@@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: lustre-v6
-Version: 1.716
+Version: 1.717
Synopsis: The Lustre V6 Verimag compiler
Description: This package contains:
(1) lus2lic: the (current) name of the compiler (and interpreter via -exec).
diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index d632f5bf428f2451faea8d578db3635a250e8534..637cf85fba401e1b1ac225ea49ca2a550063e61f 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/09/2017 (at 15:17) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/09/2017 (at 09:37) by Erwan Jahier> *)
open Lxm
@@ -510,6 +510,7 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
| [e1;e2] ->
let ve_pre = CallByPosLic(flagit Lic.PRE lxm, [e2]) in
let ve_pre = { e2 with ve_core=ve_pre } in
+ let lxm = Lxm.override_name "->" lxm in
s,CallByPosLic(flagit Lic.ARROW lxm, [e1;ve_pre])
| _ -> assert false
)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 03bddb40486c66a684e746f4165b17037e53da17..16cde1989e934797d7174779e99190aa4b854d27 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/09/2017 (at 14:13) by Erwan Jahier> *)
+(** Time-stamp: <modified the 11/09/2017 (at 16:47) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -907,7 +907,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.step = [
{
name = "step";
- lxm = nsoc_step.lxm;
+ lxm = lxm;
idx_ins = nsoc_step.idx_ins;
idx_outs = nsoc_step.idx_outs;
impl = Iterator(snd (fst nk), nsk, c);
diff --git a/src/lv6version.ml b/src/lv6version.ml
index 23044f6b9774bc3f7556d18fe14b1330d7233e4a..ea32b769cbf35fc37d5a81397ffadddc65e63e47 100644
--- a/src/lv6version.ml
+++ b/src/lv6version.ml
@@ -1,7 +1,7 @@
(** Automatically generated from Makefile *)
let tool = "lus2lic"
let branch = "master"
-let commit = "716"
-let sha_1 = "7654ff44fd22fa505ddd7580a9f4c8f9d5dececf"
+let commit = "717"
+let sha_1 = "a80c5c7342142db766bda3353b81cff2cfcc8288"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "erwan.jahier@univ-grenoble-alpes.fr"
diff --git a/src/socExec.ml b/src/socExec.ml
index cc37337e98dd3cbae94409ef661d9bf33dbf6b2c..e36fedf1193ccd7eaf03b846396d042b146e34b2 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/02/2017 (at 11:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 11/09/2017 (at 14:47) by Erwan Jahier> *)
open Soc
open Data
@@ -30,185 +30,195 @@ let (array_index : int -> var -> var_expr) =
Index(Var(vn,vt),i,vt_elt)
let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
- -> SocExecValue.ctx) =
+ -> SocExecValue.ctx) =
fun step soc_tbl soc ctx ->
- profile_info ("SocExec.soc_step \n");
- let soc_name,_,_ = soc.key in
- let ctx =
- match step.impl with
- | Extern ->
- print_string (
- "\nextern nodes and functions not yet supported in the interpreter, sorry.\n"^
- "Please use the C code generator (-2c)."
- );
- exit 2
- | Predef -> (
- try
- let ctx = SocExecEvalPredef.get soc.key ctx in
- ctx
- with Not_found -> (* Not a predef op *) print_string (
- "*** internal error in "^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
- | 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
- for i = 0 to k-1 do
- let a_i = array_index i b_array in
- let v = SocExecValue.get_value ctx a_i in
- if v = B true then incr cpt;
- done;
- let res = B (!cpt >= i && !cpt <= j) in
- let res_var = fst (List.hd outputs) in
- let s = sadd ctx.s (res_var::ctx.cpath) res in
- { ctx with s = s }
- )
- | Condact(node_sk, dft_cst) -> (
- let clk = SocExecValue.get_value ctx (Var ("activate",Bool)) in
- let vel_in, vel_out = soc.profile in
- assert(vel_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 =
- match soc.instances with
- | [] -> let (proc_name,_,_) = node_soc.key in proc_name
- | [inst] -> fst inst
- | _ -> assert false
- in
- let path_saved = ctx.cpath in
- let ctx = { ctx with cpath=inst_name::ctx.cpath } in
- let ctx =
- if clk = B true then
- let node_step = match node_soc.step with
- [step] -> step
- | _ -> assert 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 ("_memory",Bool) in
- let ctx = { ctx with cpath=path_saved } in
- let v = get_value ctx first_step in
- 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 *)
- (assert (List.length dft_cst = List.length vel_out);
- List.fold_left2 assign_expr ctx dft_cst vel_out)
- else
- (* We are not on the first step of node_soc; hence we do nothing
- and the output will keep their previous value. *)
- ctx
- in
- let ctx = { ctx with s = sadd ctx.s ("_memory"::ctx.cpath) (B false) } in
- ctx
- )
- | Iterator(iter, 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 rctx = ref ctx in
- let (proc_name,_,_) = node_soc.key in
- let inst_name =
- match soc.instances with
- | [] -> Array.make n proc_name
- | _ -> Array.of_list (List.map fst soc.instances)
- in
- for i = 0 to n-1 do
- rctx := { !rctx with cpath = inst_name.(i)::ctx.cpath };
- let vel_in, vel_out =
- match iter with
- | "map" -> (List.map (array_index i) iter_inputs,
- List.map (array_index i) iter_outputs)
- | "fold" | "red" | "fill" | "fillred" ->
- let a_in = Var (List.hd iter_inputs) in
- (
- assert(iter_inputs <> []);
- assert(iter_outputs <> []);
- a_in::(List.map (array_index i) (List.tl iter_inputs)),
- a_in::(List.map (array_index i) (List.tl iter_outputs)))
- | _ -> 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
- let a_out = Var (List.hd iter_outputs) in
- rctx := assign_expr !rctx a_in a_out); (* a_out=a_n *)
- !rctx;
- in
- ctx
-
-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,lxm) -> (
+ profile_info ("SocExec.soc_step \n");
+ let soc_name,_,_ = soc.key in
+ let ctx =
+ match step.impl with
+ | Extern ->
+ print_string (
+ "\nextern nodes and functions not yet supported in the interpreter, sorry.\n"^
+ "Please use the C code generator (-2c)."
+ );
+ exit 2
+ | Predef -> (
try
- let id_val = get_enum id ctx in
- let gaol = List.assoc id_val id_gao_l in
- let ctx = List.fold_left (do_gao lxm soc_tbl) ctx gaol in
+ let ctx = SocExecEvalPredef.get soc.key ctx in
ctx
- with Not_found -> ctx
+ with Not_found -> (* Not a predef op *) print_string (
+ "*** internal error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
+ flush stdout; assert false
)
- | Call(vel_out, Assign, vel_in,lxm) -> (
- let ctx =
- assert (List.length vel_in = List.length vel_out);
- List.fold_left2 assign_expr ctx vel_in vel_out
- in
- ctx
- )
- | Call(vel_out, Procedure sk, vel_in,lxm) -> (
- 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
- let ctx = do_step proc_name step ctx soc_tbl soc vel_in vel_out in
- { ctx with
- cpath = path_saved
- }
+ | 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
+ for i = 0 to k-1 do
+ let a_i = array_index i b_array in
+ let v = SocExecValue.get_value ctx a_i in
+ if v = B true then incr cpt;
+ done;
+ let res = B (!cpt >= i && !cpt <= j) in
+ let res_var = fst (List.hd outputs) in
+ let s = sadd ctx.s (res_var::ctx.cpath) res in
+ { ctx with s = s }
)
- | Call(vel_out, Method((inst_name,sk),step_name), vel_in,lxm) -> (
+ | Condact(node_sk, dft_cst) -> (
+ let clk = SocExecValue.get_value ctx (Var ("activate",Bool)) in
+ let vel_in, vel_out = soc.profile in
+ assert(vel_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 =
+ match soc.instances with
+ | [] -> let (proc_name,_,_) = node_soc.key in proc_name
+ | [inst] -> fst inst
+ | _ -> assert false
+ 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
+ let ctx = { ctx with cpath=inst_name::ctx.cpath } in
+ let ctx =
+ if clk = B true then
+ let node_step = match node_soc.step with
+ [step] -> step
+ | _ -> assert 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 ("_memory",Bool) in
+ let ctx = { ctx with cpath=path_saved } in
+ let v = get_value ctx first_step in
+ 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 *)
+ (assert (List.length dft_cst = List.length vel_out);
+ List.fold_left2 assign_expr ctx dft_cst vel_out)
+ else
+ (* We are not on the first step of node_soc; hence we do nothing
+ and the output will keep their previous value. *)
+ ctx
in
- let ctx = do_step inst_name step ctx soc_tbl soc vel_in vel_out in
- let ctx = { ctx with cpath = path_saved } in
+ let ctx = { ctx with s = sadd ctx.s ("_memory"::ctx.cpath) (B false) } in
ctx
)
+ | Iterator(iter, 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 rctx = ref ctx in
+ let (proc_name,_,_) = node_soc.key in
+ let inst_name =
+ match soc.instances with
+ | [] -> Array.make n proc_name
+ | _ -> Array.of_list (List.map fst soc.instances)
+ in
+ let rec f i ctx = (* iterate over the list of instances *)
+ if i=n then ctx else
+ let vel_in, vel_out =
+ match iter with
+ | "map" -> (List.map (array_index i) iter_inputs,
+ List.map (array_index i) iter_outputs)
+ | "fold" | "red" | "fill"
+ | "fillred" ->
+ let a_in = Var (List.hd iter_inputs) in
+ (
+ assert(iter_inputs <> []);
+ assert(iter_outputs <> []);
+ a_in::(List.map (array_index i) (List.tl iter_inputs)),
+ a_in::(List.map (array_index i) (List.tl iter_outputs)))
+ | _ -> assert false (* should not occur *)
+ in
+ let ctx = { ctx with cpath = inst_name.(i)::ctx.cpath } in
+ let ctx =
+ do_step inst_name.(i) node_step ctx soc_tbl node_soc vel_in vel_out
+ in
+ let ctx = { ctx with cpath = List.tl ctx.cpath } in
+ f (i+1) ctx
+ in
+ let ctx = f 0 ctx in
+ let ctx =
+ if iter <> "map" then
+ let a_in = Var (List.hd iter_inputs) in
+ let a_out = Var (List.hd iter_outputs) in
+ assign_expr ctx a_in a_out (* a_out=a_n *)
+ else
+ ctx
+ in
+ ctx
+ in
+ ctx
+
+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,lxm) -> (
+ try
+ let id_val = get_enum id ctx in
+ let gaol = List.assoc id_val id_gao_l in
+ let ctx = List.fold_left (do_gao lxm soc_tbl) ctx gaol in
+ ctx
+ with Not_found -> ctx
+ )
+ | Call(vel_out, Assign, vel_in,lxm) -> (
+ let ctx =
+ assert (List.length vel_in = List.length vel_out);
+ List.fold_left2 assign_expr ctx vel_in vel_out
+ in
+ ctx
+ )
+ | Call(vel_out, Procedure sk, vel_in,lxm) -> (
+ 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
+ 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,lxm) -> (
+ 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
+ let ctx = do_step inst_name step ctx soc_tbl soc vel_in vel_out in
+ let ctx = { ctx with cpath = path_saved } in
+ ctx
+ )
and (do_step : Lv6Id.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
- var_expr list -> var_expr list -> SocExecValue.ctx) =
+ var_expr list -> var_expr list -> SocExecValue.ctx) =
fun name step ctx soc_tbl soc vel_in vel_out ->
- profile_info ("SocExec.do_step "^name^"\n");
- 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
- { ctx with s = s_out }
+ profile_info ("SocExec.do_step "^name^"\n");
+ 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
+ { 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 =
- try List.nth l i
- with _ ->
- print_string (
+ let local_nth i l =
+ try List.nth l i
+ with _ ->
+ print_string (
"\n*** Cannot get the " ^ (string_of_int (i+1)) ^
"the 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
+ flush stdout;
+ assert false
+ in
+ let res = List.map (fun i -> local_nth i el) il in
+ res
(* [add_data_subst vtnl data_s s] add the data_s to s; *)
diff --git a/src/socExecDbg.ml b/src/socExecDbg.ml
index d88da240b2a2acc1ab41bdcbe767a9c37daca8e7..a470f1f38868e842b4a83d270f3a7e1951a72ab8 100644
--- a/src/socExecDbg.ml
+++ b/src/socExecDbg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/09/2017 (at 10:33) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/09/2017 (at 08:52) by Erwan Jahier> *)
open Soc
open Data
open SocExecValue
@@ -113,7 +113,7 @@ let (assign_expr_dbg : Lxm.t -> SocExecValue.ctx -> var_expr -> var_expr -> Even
Event.data = datal;
Event.next = (fun () -> cont nectx val_ctx);
Event.terminate = ectx.Event.terminate;
- }
+ }
in
{ ectx with
Event.kind = Event.Call;
@@ -128,13 +128,13 @@ let (assign_expr_dbg : Lxm.t -> SocExecValue.ctx -> var_expr -> var_expr -> Even
Event.nb = n;
Event.data = datal;
Event.next = (fun () -> cont2 ectx res);
- }
+ }
+
-
(* [array_index i v] returns the var_expr v[i] *)
let (array_index : int -> var -> var_expr) =
- fun i (vn,vt) ->
- let vt_elt =
+ fun i (vn,vt) ->
+ let vt_elt =
match vt with
| Array(vt_elt,_) -> vt_elt
| _ -> assert false
@@ -157,6 +157,7 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
fun lxm step soc_tbl soc ectx val_ctx cont ->
profile_info ("SocExecDbg.soc_step \n");
let soc_name,_,_ = soc.key in
+ let lxm = step.lxm in
let event =
match step.impl with
| Extern ->
@@ -169,9 +170,10 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
try
let val_ctx = SocExecEvalPredef.get soc.key val_ctx in
cont ectx val_ctx
- with Not_found -> (* Not a predef op *) print_string (
- "*** internal error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
- flush stdout; assert false
+ with Not_found -> (* Not a predef op *)
+ print_string (
+ "*** internal error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
+ flush stdout; assert false
)
| Gaol(vl,gaol) -> do_gaol soc_tbl ectx gaol val_ctx cont
@@ -242,50 +244,52 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
cont ectx val_ctx
)
)
- | Iterator(iter, node_sk, n) ->
- let node_soc = SocUtils.find 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 (proc_name,_,_) = node_soc.key in
- let inst_name =
- match soc.instances with
- | [] -> Array.make n proc_name
- | _ -> Array.of_list (List.map fst soc.instances)
- in
- (* As we need to iterate on an (instance) array, we locally switch
- to the evildark side *)
- let rval_ctx = ref val_ctx in
- let ref_event = ref ectx (* XXX dummy ?? *) in
- for i = 0 to n-1 do
- rval_ctx := { !rval_ctx with cpath = inst_name.(i)::val_ctx.cpath };
- let vel_in, vel_out =
- match iter with
- | "map" -> (List.map (array_index i) iter_inputs,
- List.map (array_index i) iter_outputs)
- | "fold" | "red" | "fill"
- | "fillred" ->
- let a_in = Var (List.hd iter_inputs) in
- ( a_in::(List.map (array_index i) (List.tl iter_inputs)),
- a_in::(List.map (array_index i) (List.tl iter_outputs)))
- | _ -> assert false (* should not occur *)
- in
- let cont ectx val_ctx = (* necessary? correct? *)
- rval_ctx := val_ctx;
- ref_event := ectx;
- cont ectx val_ctx
- in
- ref_event :=
- do_soc_step lxm inst_name.(i) node_step !rval_ctx soc_tbl
- node_soc vel_in vel_out !ref_event cont;
-
- rval_ctx := { !rval_ctx with cpath = List.tl !rval_ctx.cpath };
- done;
- if iter <> "map" then (
- let a_in = Var (List.hd iter_inputs) in
- let a_out = Var (List.hd iter_outputs) in
- rval_ctx := assign_expr !rval_ctx a_in a_out); (* a_out=a_n *)
- (* XXX use assign_expr_dbg *)
- cont !ref_event !rval_ctx
+ | Iterator(iter, node_sk, n) -> (
+ let node_soc = SocUtils.find 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 (proc_name,_,_) = node_soc.key in
+ let inst_name =
+ match soc.instances with
+ | [] -> Array.make n proc_name
+ | _ -> Array.of_list (List.map fst soc.instances)
+ in
+ let path_saved = val_ctx.cpath in
+ let rec f i cont ectx val_ctx = (* iterate over the list of instances *)
+ if i < 0 then
+ let val_ctx = if iter = "map" then val_ctx else
+ let a_in = Var (List.hd iter_inputs) in
+ let a_out = Var (List.hd iter_outputs) in
+ assign_expr val_ctx a_in a_out (* a_out=a_n *)
+ in
+ cont ectx val_ctx
+ else (
+ let vel_in, vel_out =
+ match iter with
+ | "map" -> (List.map (array_index i) iter_inputs,
+ List.map (array_index i) iter_outputs)
+ | "fold" | "red" | "fill"
+ | "fillred" ->
+ let a_in = Var (List.hd iter_inputs) in
+ ( a_in::(List.map (array_index i) (List.tl iter_inputs)),
+ a_in::(List.map (array_index i) (List.tl iter_outputs)))
+ | _ -> assert false (* should not occur *)
+ in
+ let cont ectx val_ctx =
+ let val_ctx = { val_ctx with cpath = path_saved } in
+ cont ectx val_ctx
+ in
+ let cont ectx val_ctx =
+ let val_ctx = { val_ctx with cpath = inst_name.(i)::val_ctx.cpath } in
+ do_soc_step lxm inst_name.(i) node_step val_ctx soc_tbl node_soc
+ vel_in vel_out ectx cont
+ in
+ f (i-1) cont ectx val_ctx
+ )
+ (* XXX use assign_expr_dbg to let rdbg step into iterators *)
+ in
+ f (n-1) cont ectx val_ctx
+ )
in
event
@@ -447,9 +451,12 @@ and (do_soc_step : Lxm.t -> Lv6Id.t -> step_method -> SocExecValue.ctx ->
| Predef
| Extern -> []
in
- (* let soc_step_in, soc_step_out = step.profile in *)
- let name = if (List.hd soc.step).impl = Predef then Some step_name else None in
- let sinfo = make_sinfo lxm (None) ectx
+ let name_opt =
+ (* the long names of lustre op are boring *)
+ if String.length step_name > 8 && String.sub step_name 0 8 = "Lustre::" then
+ None else Some step_name
+ in
+ let sinfo = make_sinfo lxm name_opt ectx
(List.map2 sinfo_subst vel_in step_in_vars)
(List.map2 sinfo_subst vel_out step_out_vars)
in
@@ -534,7 +541,7 @@ and (do_step_dbg : Soc.tbl -> Soc.t -> Event.t -> SocExecValue.ctx ->
(Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
fun soc_tbl soc ectx val_ctx cont ->
let soc_in_vars, soc_out_vars = soc.profile in
- (* let (datal:Data.subst list) = get_all_subst val_ctx.s in *)
+ (* let (datal:Data.subst list) = get_all_subst val_ctx.s in *)
let (datal:Data.subst list) = get_input_vals val_ctx soc_in_vars in
let (soc_name,_,_) = soc.key in
let lxm = (List.hd soc.step).lxm in
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index e04bfcb2844583afa396b6338103647f8604257a..09b1f8b4ebce8f5d8127c3f443f1b01a67f90cdf 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test Run By jahier on Fri Sep 8 10:38:01
+Test Run By jahier on Mon Sep 11 15:03:42
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic0 tests ===
@@ -66,7 +66,7 @@ XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/lecte
XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/s.lus
==> lus2lic1.sum <==
-Test Run By jahier on Fri Sep 8 10:38:01
+Test Run By jahier on Mon Sep 11 15:03:43
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic1 tests ===
@@ -412,7 +412,7 @@ PASS: sh multipar.sh
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus {}
==> lus2lic2.sum <==
-Test Run By jahier on Fri Sep 8 10:38:55
+Test Run By jahier on Mon Sep 11 15:04:37
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic2 tests ===
@@ -752,7 +752,7 @@ PASS: sh zzz2.sh
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus {}
==> lus2lic3.sum <==
-Test Run By jahier on Fri Sep 8 10:39:54
+Test Run By jahier on Mon Sep 11 15:05:36
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic3 tests ===
@@ -1266,7 +1266,7 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
==> lus2lic4.sum <==
-Test Run By jahier on Fri Sep 8 10:41:11
+Test Run By jahier on Mon Sep 11 15:06:50
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic4 tests ===
@@ -1783,14 +1783,14 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
# of unexpected failures 6
===============================
# Total number of failures: 14
-lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 0 seconds
+lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 1 seconds
lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 54 seconds
lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 59 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 77 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 74 seconds
lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 47 seconds
* Ref time:
-0.07user 0.00system 3:57.18elapsed 0%CPU (0avgtext+0avgdata 5692maxresident)k
-32inputs+0outputs (0major+6203minor)pagefaults 0swaps
+0.06user 0.01system 3:55.62elapsed 0%CPU (0avgtext+0avgdata 5580maxresident)k
+32inputs+0outputs (0major+6192minor)pagefaults 0swaps
* Quick time (-j 4):
-0.05user 0.02system 1:41.39elapsed 0%CPU (0avgtext+0avgdata 5608maxresident)k
-32inputs+0outputs (0major+6183minor)pagefaults 0swaps
+0.06user 0.01system 1:44.43elapsed 0%CPU (0avgtext+0avgdata 5648maxresident)k
+64inputs+0outputs (0major+6216minor)pagefaults 0swaps
diff --git a/test/should_work/simpleRed.lus b/test/should_work/simpleRed.lus
index d3710aef446eb7a9048b6af718abc600d67ec8cd..36c2cf97120b00805aa14a506f68305eab1dddfe 100644
--- a/test/should_work/simpleRed.lus
+++ b/test/should_work/simpleRed.lus
@@ -3,5 +3,5 @@ const m = 3 ;
node simpleRed ( a : int ) returns ( res : int );
let
- res = red << +, m >> (0 , a^m );
+ res = red << +, m >> (0 , a^m );
tel
\ No newline at end of file
diff --git a/test/should_work/test_condact.lus b/test/should_work/test_condact.lus
index adbd5a5a6a609a7a8efc5243b1fb9099340af46e..d2320832fcefcbe17e461752ad74aa3dcb70fb5a 100644
--- a/test/should_work/test_condact.lus
+++ b/test/should_work/test_condact.lus
@@ -18,4 +18,4 @@ let
-- (x, y, z) = m erge c (true -> toto(a, b)) (false -> (11, 42, 12) fby (x,y,z)) ;
tel
---
\ No newline at end of file
+-- c
\ No newline at end of file