From c71d2ed6ddf9632f744fea83c36b9fc0554ae7c7 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 27 Sep 2017 10:14:24 +0200
Subject: [PATCH] rdbg-plugin: add events that mimick node calls when array or
struct are accessed
BTW, fix iterator handling which was not working from SocExecDbg
---
_oasis | 4 +-
src/licEvalConst.ml | 6 +-
src/lustre-v6.mldylib | 3 +-
src/lustre-v6.mllib | 3 +-
src/lv6version.ml | 4 +-
src/main.ml | 2 +-
src/soc2cUtil.ml | 16 +-
src/socExecDbg.ml | 277 ++++++++++++++++++++---------
src/socExecValue.ml | 2 +-
src/socUtils.ml | 25 ++-
src/socUtils.mli | 8 +-
test/lus2lic.sum | 26 +--
test/should_work/map_red_iter.lus | 8 +-
test/should_work/test_map.lus | 8 +-
test/should_work/trivial_array.lus | 13 ++
test/should_work/when_tuple.lus | 7 +-
16 files changed, 278 insertions(+), 134 deletions(-)
diff --git a/_oasis b/_oasis
index e62fb321..e003d205 100644
--- a/_oasis
+++ b/_oasis
@@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: lustre-v6
-Version: 1.717
+Version: 1.718
Synopsis: The Lustre V6 Verimag compiler
Description: This package contains:
(1) lus2lic: the (current) name of the compiler (and interpreter via -exec).
@@ -50,5 +50,5 @@ Library "lustre-v6"
BuildDepends: str,unix,num,rdbg-plugin (>= 1.109)
Install:true
XMETAEnable: true
- InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Lv6Verbose,Soc,SocPredef,Lv6Id,SocExecDbg,SocExec,SocExecEvalPredef,Lv6Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,FreshName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Lv6Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,TopoSort,SortActions,SortActionsExpe,L2lCheckCKeyWord,L2lCheckKcgKeyWord,L2lWhenOnId,L2lNoWhenNot,L2lRemoveAlias,L2lExpandEnum
+ InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Lv6Verbose,Soc2cIdent,Soc,SocPredef,Lv6Id,SocExecDbg,SocExec,SocExecEvalPredef,Lv6Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,FreshName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Lv6Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,TopoSort,SortActions,SortActionsExpe,L2lCheckCKeyWord,L2lCheckKcgKeyWord,L2lWhenOnId,L2lNoWhenNot,L2lRemoveAlias,L2lExpandEnum
# Comment se passer de cette liste à la Prevert ?
diff --git a/src/licEvalConst.ml b/src/licEvalConst.ml
index 1d900b45..2c116992 100644
--- a/src/licEvalConst.ml
+++ b/src/licEvalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 10/07/2017 (at 10:46) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/09/2017 (at 16:51) by Erwan Jahier> *)
open AstPredef
open Lic
@@ -143,7 +143,6 @@ let f
| INT2REAL_n -> if_evaluator string_of_int ll
| AND_n -> bbb_evaluator (&&) ll
| OR_n -> bbb_evaluator (||) ll
- | XOR_n -> bbb_evaluator (<>) ll
| IMPL_n -> bbb_evaluator (fun a b -> (not a) || b) ll
| EQ_n -> aab_evaluator (=) ll
| NEQ_n -> aab_evaluator (<>) ll
@@ -170,7 +169,8 @@ let f
| RSLASH_n -> fff_evaluator (/.) ll
| RTIMES_n -> fff_evaluator ( *.) ll
| NOR_n -> boolred_evaluator 0 0 ll
- | DIESE_n -> boolred_evaluator 1 1 ll
+ | DIESE_n -> boolred_evaluator 0 1 ll
+ | XOR_n -> boolred_evaluator 1 1 ll
(*
| CondAct -> assert false
| Map -> assert false
diff --git a/src/lustre-v6.mldylib b/src/lustre-v6.mldylib
index ba6b3789..64f92c55 100644
--- a/src/lustre-v6.mldylib
+++ b/src/lustre-v6.mldylib
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: 0e59a5b102689755b86c5ab8a3414f4f)
+# DO NOT EDIT (digest: d031f6402d873c25d477fea574448e75)
Lus2licRun
SocExecValue
SocUtils
@@ -9,6 +9,7 @@ Lv6errors
Lxm
Lv6MainArgs
Lv6Verbose
+Soc2cIdent
Soc
SocPredef
Lv6Id
diff --git a/src/lustre-v6.mllib b/src/lustre-v6.mllib
index ba6b3789..64f92c55 100644
--- a/src/lustre-v6.mllib
+++ b/src/lustre-v6.mllib
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: 0e59a5b102689755b86c5ab8a3414f4f)
+# DO NOT EDIT (digest: d031f6402d873c25d477fea574448e75)
Lus2licRun
SocExecValue
SocUtils
@@ -9,6 +9,7 @@ Lv6errors
Lxm
Lv6MainArgs
Lv6Verbose
+Soc2cIdent
Soc
SocPredef
Lv6Id
diff --git a/src/lv6version.ml b/src/lv6version.ml
index ea32b769..e168b458 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 = "717"
-let sha_1 = "a80c5c7342142db766bda3353b81cff2cfcc8288"
+let commit = "718"
+let sha_1 = "2cf779843c4861964cf2903df72c46c2b233c142"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "erwan.jahier@univ-grenoble-alpes.fr"
diff --git a/src/main.ml b/src/main.ml
index 930db8ae..5f499bfa 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/07/2017 (at 17:09) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/09/2017 (at 10:09) by Erwan Jahier> *)
open Lv6Verbose
open AstV6
diff --git a/src/soc2cUtil.ml b/src/soc2cUtil.ml
index 815982e3..db4a13d2 100644
--- a/src/soc2cUtil.ml
+++ b/src/soc2cUtil.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/07/2017 (at 16:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/09/2017 (at 09:57) by Erwan Jahier> *)
open Soc2cIdent
open Data
@@ -38,15 +38,7 @@ let string_of_flow_decl (id, t) =
Printf.sprintf " %s;\n" (type_to_string t (id2s id))
open Soc
-let rec (lustre_string_of_var_expr: Soc.var_expr -> string) =
- function
- | Const("true", _) -> "true"
- | Const("false", _) -> "false"
- | Const(id, _) -> id2s id
- | Var (id,_) -> id
- | Field(f, id,_) -> Printf.sprintf "%s.%s" (lustre_string_of_var_expr f) (id2s id)
- | Index(f, index,_) -> Printf.sprintf "%s[%i]" (lustre_string_of_var_expr f) index
- | Slice(f,fi,la,st,wi,vt) -> assert false (* should not occur *)
+
let string_of_flow_decl_w7annot gaol (id, t) =
let decl = string_of_flow_decl (id, t) in
@@ -68,7 +60,7 @@ let string_of_flow_decl_w7annot gaol (id, t) =
)
| Call(_, Method((inst2,("Lustre::pre",_,_)),"set"),outs,_) ->
if inst2 = inst then
- let output_list = List.map lustre_string_of_var_expr outs in
+ let output_list = List.map SocUtils.lustre_string_of_var_expr outs in
let id2 = String.concat "," output_list in
Some id2
else
@@ -85,7 +77,7 @@ let string_of_flow_decl_w7annot gaol (id, t) =
| Some x -> x
in
let string_of_atomic_operation ao ins =
- let input_list = List.map lustre_string_of_var_expr ins in
+ let input_list = List.map SocUtils.lustre_string_of_var_expr ins in
match ao, input_list with
| Assign,_ -> None
| Procedure ("Lustre::ruminus",_,_), [a] -> Some (Printf.sprintf "-%s" a)
diff --git a/src/socExecDbg.ml b/src/socExecDbg.ml
index a470f1f3..b54a40aa 100644
--- a/src/socExecDbg.ml
+++ b/src/socExecDbg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/09/2017 (at 08:52) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/09/2017 (at 10:11) by Erwan Jahier> *)
open Soc
open Data
open SocExecValue
@@ -35,9 +35,28 @@ let (assign_expr : SocExecValue.ctx -> var_expr -> var_expr -> SocExecValue.ctx)
in
Lv6Verbose.exe ~flag:dbg (fun () -> print_string (" Done!"); flush stdout);
res
+
+let make_simple_sinfo lxm name is os =
+ Some(fun () ->
+ let atom =
+ {
+ Event.str = name;
+ Event.file = Lxm.file lxm ;
+ Event.line = Lxm.line lxm ,Lxm.line lxm ;
+ Event.char = Lxm.cstart lxm, Lxm.cend lxm;
+ Event.stack = None;
+ }
+ in
+ {
+ Event.expr = Expr.Var (Lxm.str lxm);
+ Event.atoms = [atom];
+ Event.more = None;
+ Event.in_subst = is ;
+ Event.out_subst = os ;
+ }
+ )
let make_sinfo lxm name_opt ectx in_subst out_subst =
- let l = Lxm.line lxm in
(* if l <= 0 then None else *)
Some(fun () ->
let atom =
@@ -145,8 +164,84 @@ let get_all_subst = SocExecValue.filter_top_subst
let get_all_subst = SocExecValue.substs_to_data_subst
let get_input_vals val_ctx in_vars =
let datal = SocExecValue.get_vals val_ctx in
- let datal = List.filter (fun (x,_) -> List.mem_assoc x in_vars) datal in
+ let datal = List.filter (fun (x,_) -> List.mem_assoc x in_vars||x="_memory") datal in
datal
+
+(* Generates events that mimick node calls when array or struct are accessed *)
+let (gen_access_events :
+ Lxm.t -> var_expr -> Event.t -> SocExecValue.ctx ->
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ fun lxm v ectx val_ctx cont ->
+ let v_str = SocUtils.lustre_string_of_var_expr v in
+ let ve,id,short_id,t = match v with
+ | Index(ve, i, t) -> ve, v_str,
+ "["^string_of_int i^"]", t
+ | Field(ve, id, t) -> ve, "access_field_"^id, "."^id, t
+ | _ -> assert false (* sno *)
+ in
+ let initial_sinfo = ectx.sinfo in
+ let top = SocUtils.get_top_var ve in
+ let v_in = SocUtils.lustre_string_of_var_expr top, data_type_of_var_expr top in
+ let v_out = v_str, t in
+ let lxm = Lxm.override_name short_id lxm in
+ let sinfo = make_simple_sinfo lxm short_id [v_in,v_in] [v_out,v_out] in
+ let val_ctx0 = { val_ctx with cpath = (List.tl val_ctx.cpath) } in
+ let val_v_in = SocExecValue.get_value val_ctx0 ve in
+ let (data:Data.subst list) = [ fst v_in, val_v_in] in
+ let cont2 local_ectx val_ctx =
+ let nectx = Event.incr_event_nb local_ectx in
+ let nectx = { nectx with Event.sinfo = initial_sinfo } in
+ let val_v_out =
+ match v, val_v_in with
+ | Index(ve, i, t) , A a -> a.(i)
+ | Field(ve, id, t), S fl -> (try List.assoc id fl with _ -> assert false (*sno *))
+ | _,U -> U
+ | _,_ -> assert false
+ in
+ let data = (fst v_out, val_v_out)::data in
+ {
+ Event.step = ectx.Event.step;
+ Event.nb = nectx.Event.nb;
+ Event.depth = ectx.Event.depth;
+ Event.kind = Event.Exit;
+ Event.lang = "lustre";
+ Event.name = id;
+ Event.inputs = [v_in];
+ Event.outputs = [v_out];
+ Event.locals = [];
+ Event.sinfo = sinfo;
+ Event.data = data;
+ Event.next = (fun () -> cont nectx val_ctx);
+ Event.terminate = ectx.Event.terminate;
+ }
+ in
+ {
+ Event.step = ectx.Event.step;
+ Event.nb = ectx.Event.nb;
+ Event.depth = ectx.Event.depth;
+ Event.kind = Event.Call;
+ Event.lang = "lustre";
+ Event.name = id;
+ Event.inputs = [v_in];
+ Event.outputs = [v_out];
+ Event.locals = [];
+ Event.sinfo = sinfo;
+ Event.data = data;
+ Event.next = (fun () -> cont2 ectx val_ctx);
+ Event.terminate = ectx.Event.terminate;
+ }
+
+let rec (gen_access_events_list :
+ Lxm.t -> var_expr list -> Event.t -> SocExecValue.ctx ->
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ fun lxm vel_in ectx val_ctx cont ->
+ let vel_in = List.filter (function Index _ | Field _ -> true | _ -> false) vel_in in
+ match vel_in with
+ | [] -> cont ectx val_ctx
+ | ve_in::tail ->
+ let cont ectx val_ctx = gen_access_events lxm ve_in ectx val_ctx cont in
+ gen_access_events_list lxm tail ectx val_ctx cont
+
exception SourceInfoError of (string * string)
@@ -220,7 +315,7 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
in
cont ectx val_ctx
in
- do_soc_step lxm inst_name node_step val_ctx soc_tbl node_soc
+ do_soc_step lxm None node_step val_ctx soc_tbl node_soc
vel_in vel_out ectx cont
) else (
let first_step = Var ("_memory",Bool) in
@@ -255,13 +350,9 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
| _ -> Array.of_list (List.map fst soc.instances)
in
let path_saved = val_ctx.cpath in
+ let add_i i (id,t) = (Printf.sprintf "%s_%d" id i), t 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 =
@@ -270,9 +361,18 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
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)))
+ let a_in = (List.hd iter_inputs) in
+ let a_in_i, a_in_ip1 =
+ if i = 0 then
+ Var (a_in), Var (add_i 1 a_in)
+ else
+ if i = n-1 then
+ Var (add_i i a_in), Var (List.hd iter_outputs)
+ else
+ Var (add_i i a_in), Var (add_i (i+1) a_in)
+ in
+ ( a_in_i::( List.map (array_index i) (List.tl iter_inputs)),
+ a_in_ip1::(List.map (array_index i) (List.tl iter_outputs)))
| _ -> assert false (* should not occur *)
in
let cont ectx val_ctx =
@@ -280,9 +380,10 @@ let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
cont ectx val_ctx
in
let cont ectx val_ctx =
+ let lxm = node_step.lxm in
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
+ do_soc_step lxm (Some i) node_step val_ctx
+ soc_tbl node_soc vel_in vel_out ectx cont
in
f (i-1) cont ectx val_ctx
)
@@ -376,19 +477,19 @@ and (do_gao : Soc.tbl -> Event.t -> gao -> SocExecValue.ctx ->
List.fold_left2 assign_expr val_ctx vel_in vel_out
in
cont ectx val_ctx
- *)
- let fcont =
- List.fold_left2
- (fun acc_cont ve_in ve_out ->
- let ncont ectx val_ctx =
- assign_expr_dbg lxm val_ctx ve_in ve_out ectx acc_cont in
- ncont
- )
- cont
- vel_in
- vel_out
- in
- fcont ectx val_ctx
+ *)
+ let fcont =
+ List.fold_left2
+ (fun acc_cont ve_in ve_out ->
+ let ncont ectx val_ctx =
+ assign_expr_dbg lxm val_ctx ve_in ve_out ectx acc_cont in
+ ncont
+ )
+ cont
+ vel_in
+ vel_out
+ in
+ fcont ectx val_ctx
)
| Call(vel_out, Procedure sk, vel_in, lxm) -> (
let (proc_name,_,_) = sk in
@@ -401,7 +502,7 @@ and (do_gao : Soc.tbl -> Event.t -> gao -> SocExecValue.ctx ->
cont ectx val_ctx
in
let cont ectx val_ctx =
- do_soc_step lxm proc_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
+ do_soc_step lxm None step val_ctx soc_tbl soc vel_in vel_out ectx cont
in
cont ectx val_ctx
)
@@ -417,105 +518,107 @@ and (do_gao : Soc.tbl -> Event.t -> gao -> SocExecValue.ctx ->
cont ectx val_ctx
in
let cont ectx val_ctx =
- do_soc_step lxm inst_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
+ do_soc_step lxm None step val_ctx soc_tbl soc vel_in vel_out ectx cont
in
cont ectx val_ctx
)
-and (do_soc_step : Lxm.t -> Lv6Id.t -> step_method -> SocExecValue.ctx ->
+and (do_soc_step : Lxm.t -> int option -> step_method -> SocExecValue.ctx ->
Soc.tbl -> Soc.t -> var_expr list -> var_expr list -> Event.t ->
(Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
- fun lxm name step val_ctx soc_tbl soc vel_in vel_out ectx cont ->
- profile_info ("SocExecDbg.do_soc_step "^name^"\n");
+ fun lxm int_opt step val_ctx0 soc_tbl soc vel_in vel_out ectx0 cont0 ->
+ let (soc_name,_,_) = soc.key in
+ profile_info ("SocExecDbg.do_soc_step "^soc_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 val_ctx in
- let val_ctx = { val_ctx with s = new_s } in
- let cont ectx val_ctx =
- let s_out = substitute_params_and_args step_out_vars vel_out val_ctx in
- cont ectx { val_ctx with s = s_out }
- in
- (* let (datal:Data.subst list) = get_all_subst val_ctx.s in *)
- let datal = get_input_vals val_ctx step_in_vars in
- let (soc_name,_,_) = soc.key in
+ let new_s = substitute_args_and_params vel_in step_in_vars val_ctx0 in
let step_name = match soc.step with
[_] -> soc_name
| _ -> soc_name^"."^step.name
in
+ let step_name = match int_opt with
+ | Some i -> Printf.sprintf "%s_%d" step_name i
+ | None -> step_name
+ in
let locals = if soc.step = [] then [] else
match (List.hd soc.step).impl with
| Gaol (var_list, _) -> var_list
| Iterator _
| Boolred _
| Condact _
- | Predef
- | Extern -> []
+ | Extern
+ | Predef -> []
+ in
+ let locals = match soc.memory with
+ | No_mem | Mem_hidden -> locals
+ | Mem dt -> ("_memory",dt)::locals
in
let name_opt =
- (* the long names of lustre op are boring *)
+ (* 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
+ let initial_sinfo = ectx0.Event.sinfo in
+ let ectx0 = {
+ ectx0 with
+ Event.depth = ectx0.Event.depth+1;
+ }
+ in
+ let sinfo = make_sinfo lxm name_opt ectx0
(List.map2 sinfo_subst vel_in step_in_vars)
(List.map2 sinfo_subst vel_out step_out_vars)
in
- let initial_sinfo = ectx.Event.sinfo in
- let ectx = {
- ectx with
- Event.name = step_name;
- Event.depth = ectx.Event.depth+1;
- Event.data = datal;
- Event.inputs = fst soc.profile;
- Event.outputs = snd soc.profile;
- Event.locals = locals;
- Event.sinfo = sinfo;
- }
- in
let cont2 local_ectx val_ctx =
- (* let (datal:Data.subst list) = List.map
- (fun v -> fst v, SocExecValue.get_val (fst v) val_ctx) step_out_vars
- in *)
+ let cont3 ectx val_ctx =
+ let s_out = substitute_params_and_args step_out_vars vel_out val_ctx in
+ cont0 ectx { val_ctx with s = s_out }
+ in
let (datal:Data.subst list) = SocExecValue.get_vals val_ctx in
let nectx = Event.incr_event_nb local_ectx in
let nectx = Event.decr_event_depth nectx in
let nectx = { nectx with Event.sinfo = initial_sinfo } in
{
- Event.step = ectx.Event.step;
+ Event.step = nectx.Event.step;
Event.nb = local_ectx.Event.nb;
- Event.depth = ectx.Event.depth;
+ Event.depth = ectx0.Event.depth;
Event.kind = Event.Exit;
Event.lang = "lustre";
Event.name = step_name;
- Event.inputs = ectx.Event.inputs;
- Event.outputs = ectx.Event.outputs;
- Event.locals = ectx.Event.locals;
+ Event.inputs = nectx.Event.inputs;
+ Event.outputs = nectx.Event.outputs;
+ Event.locals = nectx.Event.locals;
Event.sinfo = sinfo;
Event.data = datal;
- Event.next = (fun () -> cont nectx val_ctx);
- Event.terminate = ectx.Event.terminate;
+ Event.next = (fun () -> cont3 nectx val_ctx);
+ Event.terminate = nectx.Event.terminate;
}
in
- {
- Event.step = ectx.Event.step;
- Event.nb = ectx.Event.nb;
- Event.depth = ectx.Event.depth;
- Event.kind = Event.Call;
- Event.lang = "lustre";
- Event.name = step_name;
- Event.inputs = ectx.Event.inputs;
- Event.outputs = ectx.Event.outputs;
- Event.locals = ectx.Event.locals;
- Event.sinfo = sinfo;
- Event.data = ectx.Event.data;
- Event.next = (fun () ->
- assert (List.mem step soc.step);
- let ectx = Event.incr_event_nb ectx in
- soc_step lxm step soc_tbl soc ectx { val_ctx with s=new_s } cont2
- );
- Event.terminate = ectx.Event.terminate;
- }
-
+ let cont1 lectx val_ctx =
+ let ectx = {
+ lectx with
+ Event.name = step_name;
+ Event.inputs = fst soc.profile;
+ Event.outputs = snd soc.profile;
+ Event.locals = locals;
+ Event.sinfo = sinfo;
+ }
+ in
+ let ectx = Event.incr_event_nb ectx in
+ let val_ctx = { val_ctx with s = new_s } in
+ (* let (datal:Data.subst list) = get_all_subst val_ctx.s in *)
+ let datal = get_input_vals val_ctx step_in_vars in
+ { ectx with
+ Event.kind = Event.Call;
+ Event.lang = "lustre";
+ Event.data = datal;
+ Event.next = (fun () ->
+ assert (List.mem step soc.step);
+ let ectx = Event.incr_event_nb ectx in
+ soc_step lxm step soc_tbl soc ectx val_ctx cont2
+ );
+ }
+ in
+ gen_access_events_list step.lxm vel_in ectx0 val_ctx0 cont1
(* get the step params from its soc params *)
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index e01424d8..2384d166 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 29/08/2017 (at 15:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/09/2017 (at 17:27) by Erwan Jahier> *)
let dbg = (Lv6Verbose.get_flag "exec")
diff --git a/src/socUtils.ml b/src/socUtils.ml
index 3b1bcfb6..837b1b72 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/09/2017 (at 17:02) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/09/2017 (at 09:56) by Erwan Jahier> *)
open Soc
@@ -388,3 +388,26 @@ let (filter_step_params : int list -> 'a list -> 'a list) =
let _ = (
assert (filter_step_params [0;1;4] ["v1";"v2";"v3";"v4";"v5"] = ["v1";"v2";"v5"]))
+
+
+let rec (get_top_var : Soc.var_expr -> Soc.var_expr) =
+ fun var ->
+(* if var = t.[2].field, then it returns (also) t.[2] and t *)
+ match var with
+ | Soc.Slice(ve,_,_,_,_,_)
+ | Soc.Field(ve,_,_)
+ | Soc.Index(ve,_,_) -> get_top_var ve
+ | Soc.Var(_,vt)
+ | Soc.Const(_,vt) -> var
+
+open Soc2cIdent
+let rec (lustre_string_of_var_expr: Soc.var_expr -> string) =
+ function
+ | Const("true", _) -> "true"
+ | Const("false", _) -> "false"
+ | Const(id, _) -> id2s id
+ | Var (id,_) -> id
+ | Field(f, id,_) -> Printf.sprintf "%s.%s" (lustre_string_of_var_expr f) (id2s id)
+ | Index(f, index,_) -> Printf.sprintf "%s[%i]" (lustre_string_of_var_expr f) index
+ | Slice(f,fi,la,st,wi,vt) -> assert false (* should not occur *)
+
diff --git a/src/socUtils.mli b/src/socUtils.mli
index 83531dc7..c7d47f2e 100644
--- a/src/socUtils.mli
+++ b/src/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/09/2017 (at 17:02) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/09/2017 (at 09:54) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -71,3 +71,9 @@ nb : we suppose that the index list is in increasing order.
val filter_step_params : int list -> 'a list -> 'a list
val get_rank : 'a -> ('a * 'b) list -> int
+
+
+(* if var = t.[2].field, then it returns (also) t.[2] and t *)
+val get_top_var : Soc.var_expr -> Soc.var_expr
+
+val lustre_string_of_var_expr: Soc.var_expr -> string
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 09b1f8b4..ea7658c5 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test Run By jahier on Mon Sep 11 15:03:42
+Test Run By jahier on Wed Sep 27 09:40:20
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 Mon Sep 11 15:03:43
+Test Run By jahier on Wed Sep 27 09:40:21
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 Mon Sep 11 15:04:37
+Test Run By jahier on Wed Sep 27 09:41:17
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 Mon Sep 11 15:05:36
+Test Run By jahier on Wed Sep 27 09:42:18
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 Mon Sep 11 15:06:50
+Test Run By jahier on Wed Sep 27 09:43:31
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic4 tests ===
@@ -1784,13 +1784,13 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
===============================
# Total number of failures: 14
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 74 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 47 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 56 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 61 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 73 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 49 seconds
* Ref time:
-0.06user 0.01system 3:55.62elapsed 0%CPU (0avgtext+0avgdata 5580maxresident)k
-32inputs+0outputs (0major+6192minor)pagefaults 0swaps
+0.06user 0.00system 3:59.96elapsed 0%CPU (0avgtext+0avgdata 5564maxresident)k
+96inputs+0outputs (0major+6134minor)pagefaults 0swaps
* Quick time (-j 4):
-0.06user 0.01system 1:44.43elapsed 0%CPU (0avgtext+0avgdata 5648maxresident)k
-64inputs+0outputs (0major+6216minor)pagefaults 0swaps
+0.05user 0.02system 2:20.68elapsed 0%CPU (0avgtext+0avgdata 5424maxresident)k
+128inputs+0outputs (0major+6122minor)pagefaults 0swaps
diff --git a/test/should_work/map_red_iter.lus b/test/should_work/map_red_iter.lus
index 4a78e2fb..f0f6dcee 100644
--- a/test/should_work/map_red_iter.lus
+++ b/test/should_work/map_red_iter.lus
@@ -54,10 +54,10 @@ let
tel
node map_red_iter (indice_gen : int ;
- InfoGenIndiv : T_InfoGenIndiv ;
- InfoGenGlob : T_InfoGenGlob ;
- TabEtatCharge : T_EtatCharge^NBC;
- TabComVal : bool^NBC)
+ InfoGenIndiv : T_InfoGenIndiv ;
+ InfoGenGlob : T_InfoGenGlob ;
+ TabEtatCharge : T_EtatCharge^NBC;
+ TabComVal : bool^NBC)
returns (TabComChg : T_ComChg^NBC);
var bidon : int;
let
diff --git a/test/should_work/test_map.lus b/test/should_work/test_map.lus
index 9a427eac..c0fe9f47 100644
--- a/test/should_work/test_map.lus
+++ b/test/should_work/test_map.lus
@@ -1,7 +1,7 @@
-function myplus<<type t>>(x, y : t) returns (o : t);
+function myplus<<type t>>(e1, e2 : t) returns (res : t);
let
- o = x + y;
+ res = e1 + e2;
tel
const n=4;
@@ -12,7 +12,7 @@ let
(* o = titi<<int>>(x,y); *)
tel
-function test_map(x,y: real^n) returns (o: real^n);
+function test_map(a,b: real^n) returns (c: real^n);
let
- o = titi<<real>>(x,y);
+ c = titi<<real>>(a,b);
tel
diff --git a/test/should_work/trivial_array.lus b/test/should_work/trivial_array.lus
index e42e52fb..8df13225 100644
--- a/test/should_work/trivial_array.lus
+++ b/test/should_work/trivial_array.lus
@@ -3,3 +3,16 @@ let
y = [x]|[x]|[x]|[x];
tel
+function trivial_array2(x:int^3) returns (y: int);
+let
+ y = x[0]+x[2]*x[1];
+tel
+
+function trivial_array3(i:int) returns (y: int);
+var
+ x : int^3;
+let
+ x = i^3;
+ y = x[0]+x[2]*x[1];
+tel
+
diff --git a/test/should_work/when_tuple.lus b/test/should_work/when_tuple.lus
index e355b947..f1e4a94d 100644
--- a/test/should_work/when_tuple.lus
+++ b/test/should_work/when_tuple.lus
@@ -3,7 +3,7 @@ node when_tuple(a, b, c: bool) returns (x: bool when a; y: bool when a);
let
-- XXX should we accept that ?
- (x, y) = toto((b, c) when a);
+ (x, y) = tutu((b, c) when a);
tel
@@ -14,3 +14,8 @@ let
(a, b, c)= (x, x, x) when clk;
tel
extern node toto(u: bool; v: bool) returns (x: bool; y: bool);
+
+node tutu(u: bool; v: bool) returns (x: bool; y: bool);
+let
+ (x,y)= (u,v);
+tel
\ No newline at end of file
--
GitLab