diff --git a/_oasis b/_oasis
index b8ed30563083144cea403cb035e6a3e6747c9c89..8f43809c9f7196806e6f150a97bd46d6683d62df 100644
--- a/_oasis
+++ b/_oasis
@@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: lustre-v6
-Version: 1.715
+Version: 1.716
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 734c697593b8fe75daf57b726b11e9fb8a420c62..d632f5bf428f2451faea8d578db3635a250e8534 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/07/2017 (at 16:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/09/2017 (at 15:17) by Erwan Jahier> *)
open Lxm
@@ -452,12 +452,13 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
It is the good spot to do that? what could be a better spot?
*)
- let array_val_exp =
+ let array_val_exp =
+ let lxm = Lxm.override_name "[ ]" lxm in
{ ve_core = CallByPosLic(flagit Lic.ARRAY lxm, vel_eff);
ve_typ = [Array_type_eff(List.hd (List.hd vel_eff).ve_typ,
List.length vel_eff)];
ve_clk = (List.hd vel_eff).ve_clk;
- ve_src = lxm
+ ve_src = lxm
}
in
CallByPosLic(flagit by_pos_op_eff lxm, [array_val_exp])
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 2446fb49b13e759d6113a18051ba121df907bd0c..03bddb40486c66a684e746f4165b17037e53da17 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 17/08/2017 (at 18:24) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/09/2017 (at 14:13) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -564,9 +564,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
let mems = mems@mems2 in
let deps = ActionsDeps.concat deps deps2 in
- let actions =
- (clk, inputs, lpl, Soc.Assign,cc_flg.src)::actions@actions2
- in
+ let actions = actions@actions2 in
ctx, actions, inputs, mems, deps
)
acc
@@ -970,7 +968,7 @@ 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
+ let soc = SocPredef.of_soc_key lxm soc_key in
Some(ctx, soc, soc_tbl)
with _ ->
(* This extern node is not a predef *)
diff --git a/src/lv6version.ml b/src/lv6version.ml
index 5503d93278f2e1c0c34096e435a03e776137b763..23044f6b9774bc3f7556d18fe14b1330d7233e4a 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 = "715"
-let sha_1 = "f4e24e44d35687d99fd07d55d1ffb567a25195bc"
+let commit = "716"
+let sha_1 = "7654ff44fd22fa505ddd7580a9f4c8f9d5dececf"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "erwan.jahier@univ-grenoble-alpes.fr"
diff --git a/src/lxm.ml b/src/lxm.ml
index 86adea53871d39a121795473b15c9dec773c6902..d94fc38d3a4ae5c88e9b86d56e925a9e7d34f2ac 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/09/2017 (at 15:14) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
@@ -44,6 +44,9 @@ let position lxm = (
Printf.sprintf "line:%d, col:%d to %d"
lxm._line lxm._cstart lxm._cend
)
+let (override_name : string -> t -> t) =
+ fun nname lxm ->
+ { lxm with _str=nname }
(* constructeur de type flaggé avec un lexeme *)
type 'a srcflagged = {
diff --git a/src/lxm.mli b/src/lxm.mli
index bae67cdf8bb373376b788af3f08def21d39cc9bf..e417cdc9e4b5133dd4d5428be4944da1d73e1785 100644
--- a/src/lxm.mli
+++ b/src/lxm.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/09/2017 (at 15:14) by Erwan Jahier> *)
(** Lexemes *)
@@ -16,6 +16,8 @@ val line : t -> int
val file : t -> string
val pragma : t -> pragma list
+val override_name : string -> t -> t
+
(** column numbers *)
val cstart : t -> int
val cend : t -> int
diff --git a/src/socExecDbg.ml b/src/socExecDbg.ml
index 738633b100c1d015bf909d384675fa209ef67cf4..d88da240b2a2acc1ab41bdcbe767a9c37daca8e7 100644
--- a/src/socExecDbg.ml
+++ b/src/socExecDbg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/09/2017 (at 11:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/09/2017 (at 10:33) by Erwan Jahier> *)
open Soc
open Data
open SocExecValue
@@ -36,6 +36,101 @@ let (assign_expr : SocExecValue.ctx -> var_expr -> var_expr -> SocExecValue.ctx)
Lv6Verbose.exe ~flag:dbg (fun () -> print_string (" Done!"); flush stdout);
res
+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 =
+ {
+ Event.str = (match name_opt with Some n -> n | None -> Lxm.str lxm);
+ (* Event.str = (Lxm.str lxm); *)
+ Event.file = Lxm.file lxm ;
+ Event.line = Lxm.line lxm ,Lxm.line lxm ;
+ Event.char = Lxm.cstart lxm, Lxm.cend lxm;
+ Event.stack =
+ match ectx.Event.sinfo with
+ | None -> None
+ | Some si -> Some (List.hd ((si()).Event.atoms));
+ }
+ in
+ {
+ Event.expr = Expr.Var (Lxm.str lxm);
+ Event.atoms = [atom];
+ Event.more = None; (* yet *)
+ Event.in_subst = in_subst ;
+ Event.out_subst = out_subst ;
+ }
+ )
+let sinfo_subst arg var =
+ match arg with
+ | Var v -> v,var
+ | Const v -> v,var
+ | Field (_,_,t)
+ | Index (_,_,t)
+ | Slice (_,_,_,_,_,t) -> (SocUtils.string_of_filter arg, t), var
+
+
+let (assign_expr_dbg : Lxm.t -> SocExecValue.ctx -> var_expr -> var_expr -> Event.t ->
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ fun lxm ctx ve_in ve_out ectx cont -> (* ve_out := ve_in (in ctx) *)
+ let val_ve_in = SocExecValue.get_value ctx ve_in in
+ let res =
+ { ctx with
+ s =
+ let v = val_ve_in in
+ sadd_partial ctx.s ve_out ctx.cpath v
+ }
+ in
+ (* let (datal:Data.subst list) = SocExecValue.get_vals res in *)
+ let (datal:Data.subst list) = ["rhs",val_ve_in] in
+ let n = ectx.Event.nb in
+ let ectx = { ectx with
+ Event.nb = ectx.Event.nb+1;
+ Event.depth = ectx.Event.depth+1;
+ }
+ in
+ let t = data_type_of_var_expr ve_in in
+ let sinfo = make_sinfo lxm (Some ":=") ectx
+ [sinfo_subst ve_in ("rhs", t)]
+ [sinfo_subst ve_out ("lhs", t)]
+ in
+ let cont2 local_ectx val_ctx =
+ let (datal:Data.subst list) = [("rhs",val_ve_in);("lhs",val_ve_in)] in
+ let nectx = Event.incr_event_nb local_ectx in
+ let nectx = Event.decr_event_depth nectx in
+ {
+ Event.kind = Event.Exit;
+ Event.name = "Assign";
+ Event.lang = "lustre";
+ Event.inputs = [("rhs", t)];
+ Event.outputs = ["lhs", t];
+ Event.locals = [];
+
+ Event.step = ectx.Event.step;
+ Event.nb = local_ectx.Event.nb;
+ Event.depth = ectx.Event.depth;
+ Event.sinfo = sinfo;
+ Event.data = datal;
+ Event.next = (fun () -> cont nectx val_ctx);
+ Event.terminate = ectx.Event.terminate;
+ }
+ in
+ { ectx with
+ Event.kind = Event.Call;
+ Event.name = "Assign";
+ Event.lang = "lustre";
+ Event.inputs = [("rhs", t)];
+ Event.outputs = ["lhs", t];
+ Event.locals = [];
+
+ Event.sinfo = sinfo;
+ Event.step = ectx.Event.step;
+ 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) ->
@@ -57,427 +152,473 @@ exception SourceInfoError of (string * string)
let rec (soc_step : Lxm.t -> Soc.step_method -> Soc.tbl -> Soc.t ->
- Event.t -> SocExecValue.ctx ->
- (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ Event.t -> SocExecValue.ctx ->
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
fun lxm step soc_tbl soc ectx val_ctx cont ->
- profile_info ("SocExecDbg.soc_step \n");
- let soc_name,_,_ = soc.key in
- let event =
- 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 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
- )
- | Gaol(vl,gaol) -> do_gaol soc_tbl ectx gaol val_ctx cont
-
- | 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 val_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 val_ctx.s (res_var::val_ctx.cpath) res in
- cont ectx { val_ctx with s = s }
- )
- | Condact(node_sk, dft_cst) -> (
- let clk = SocExecValue.get_value val_ctx (Var ("activate",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_out = List.map (fun x -> Var x) vel_out in
- let node_soc = SocUtils.find 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
+ profile_info ("SocExecDbg.soc_step \n");
+ let soc_name,_,_ = soc.key in
+ let event =
+ 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 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
+ )
+ | Gaol(vl,gaol) -> do_gaol soc_tbl ectx gaol val_ctx cont
+
+ | 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 val_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 val_ctx.s (res_var::val_ctx.cpath) res in
+ cont ectx { val_ctx with s = s }
+ )
+ | Condact(node_sk, dft_cst) -> (
+ let clk = SocExecValue.get_value val_ctx (Var ("activate",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_out = List.map (fun x -> Var x) vel_out in
+ let node_soc = SocUtils.find 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 = val_ctx.cpath in
+ let val_ctx = { val_ctx with cpath=inst_name::val_ctx.cpath } in
+ if clk = B true then (
+ let node_step = match node_soc.step with
+ [step] -> step
| _ -> assert false
in
- let path_saved = val_ctx.cpath in
- let val_ctx = { val_ctx with cpath=inst_name::val_ctx.cpath } in
- if clk = B true then (
- let node_step = match node_soc.step with
- [step] -> step
- | _ -> assert false
- in
- let cont ectx val_ctx =
- let val_ctx =
- {
- cpath=path_saved;
- s = sadd val_ctx.s ("_memory"::val_ctx.cpath) (B false)
- }
- in
- cont ectx val_ctx
- in
- do_soc_step lxm inst_name node_step val_ctx soc_tbl node_soc
- vel_in vel_out ectx cont
- ) else (
- let first_step = Var ("_memory",Bool) in
- let val_ctx = { val_ctx with cpath=path_saved } in
- let v = get_value val_ctx first_step in
+ let cont ectx val_ctx =
let val_ctx =
- 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 val_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. *)
- val_ctx
- in
- let val_ctx = { val_ctx with
- s = sadd val_ctx.s ("_memory"::val_ctx.cpath) (B false) }
+ {
+ cpath=path_saved;
+ s = sadd val_ctx.s ("_memory"::val_ctx.cpath) (B false)
+ }
in
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
+ do_soc_step lxm inst_name node_step val_ctx soc_tbl node_soc
+ vel_in vel_out ectx cont
+ ) else (
+ let first_step = Var ("_memory",Bool) in
+ let val_ctx = { val_ctx with cpath=path_saved } in
+ let v = get_value val_ctx first_step in
+ let val_ctx =
+ 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 val_ctx dft_cst vel_out)
+ (* XXX use assign_expr_dbg *)
+ else
+ (* We are not on the first step of node_soc; hence we do nothing
+ and the output will keep their previous value. *)
+ val_ctx
+ in
+ let val_ctx = { val_ctx with
+ s = sadd val_ctx.s ("_memory"::val_ctx.cpath) (B false) }
+ in
+ 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 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 *)
- cont !ref_event !rval_ctx
- in
- event
+ | _ -> 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
+ in
+ event
and (do_gaol : Soc.tbl -> Event.t -> gao list -> SocExecValue.ctx ->
- (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
- fun soc_tbl ectx gaol val_ctx cont -> match gaol with
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ fun soc_tbl ectx gaol val_ctx cont ->
+ match gaol with
| [] -> assert false
| [gao] -> do_gao soc_tbl ectx gao val_ctx cont
| gao::gaol ->
- let cont ectx val_ctx = do_gaol soc_tbl ectx gaol val_ctx cont in
- do_gao soc_tbl ectx gao val_ctx cont
+ let cont ectx val_ctx = do_gaol soc_tbl ectx gaol val_ctx cont in
+ do_gao soc_tbl ectx gao val_ctx cont
and (do_gao : Soc.tbl -> Event.t -> gao -> SocExecValue.ctx ->
- (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
fun soc_tbl ectx gao val_ctx cont ->
- match gao with
- | Case(id, id_gao_l,lxm) -> (
- try
- let id_val = get_enum id val_ctx in
- let gaol = List.assoc id_val id_gao_l in
- do_gaol soc_tbl ectx gaol val_ctx cont
- with Not_found -> cont ectx val_ctx
- )
- | Call(vel_out, Assign, vel_in, lxm) -> (
- let val_ctx =
- assert (List.length vel_in = List.length vel_out);
- List.fold_left2 assign_expr val_ctx vel_in vel_out
- in
- cont ectx val_ctx
- )
- | Call(vel_out, Procedure sk, vel_in, lxm) -> (
- let (proc_name,_,_) = sk in
- let path_saved = val_ctx.cpath in
- let val_ctx = { val_ctx with cpath = proc_name::val_ctx.cpath } in
- let soc = SocUtils.find lxm sk soc_tbl in
- let step = match soc.step with [step] -> step | _ -> assert false in
- let cont ectx val_ctx =
- let val_ctx = { val_ctx with cpath = path_saved } in
- cont ectx val_ctx
+ match gao with
+ | Case(id, id_gao_l,lxm) -> (
+ try
+ let id_val = get_enum id val_ctx in
+ let gaol = List.assoc id_val id_gao_l in
+ (* do_gaol soc_tbl ectx gaol val_ctx cont *)
+
+ let v = Data.E(id_val, SocUtils.get_rank id_val id_gao_l) in
+ let t = Enum(id,List.map fst id_gao_l) in
+ let clk_var = Var(id,t) in
+ let (datal:Data.subst list) = ["clock", v] in
+
+ let clock = ("clock", t) in
+ let n = ectx.Event.nb in
+ let ectx = { ectx with
+ Event.nb = ectx.Event.nb+1;
+ (* Event.depth = ectx.Event.depth+1; *)
+ }
in
- let cont ectx val_ctx =
- do_soc_step lxm proc_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
+ let sinfo = make_sinfo lxm (Some "when") ectx
+ [sinfo_subst clk_var clock]
+ []
in
- cont ectx val_ctx
- )
- | Call(vel_out, Method((inst_name,sk),step_name), vel_in, lxm) -> (
- let path_saved = val_ctx.cpath in
- let val_ctx = { val_ctx with cpath = inst_name::val_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 cont ectx val_ctx =
- let val_ctx = { val_ctx with cpath = path_saved } in
- cont ectx val_ctx
+ let cont2 local_ectx val_ctx =
+ let nectx = Event.incr_event_nb local_ectx in
+ (* let nectx = Event.decr_event_depth nectx in *)
+ {
+ Event.kind = Event.Exit;
+ Event.name = "when";
+ Event.lang = "lustre";
+ Event.inputs = [clock];
+ Event.outputs = [];
+ Event.locals = [];
+
+ Event.step = ectx.Event.step;
+ Event.nb = local_ectx.Event.nb;
+ Event.depth = ectx.Event.depth+1;
+ Event.sinfo = sinfo;
+ Event.data = datal;
+ Event.next = (fun () -> cont nectx val_ctx);
+ Event.terminate = ectx.Event.terminate;
+ }
in
- let cont ectx val_ctx =
- do_soc_step lxm inst_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
+ { ectx with
+ Event.kind = Event.Call;
+ Event.name = "when";
+ Event.lang = "lustre";
+ Event.inputs = [clock];
+ Event.outputs = [];
+ Event.locals = [];
+
+ Event.depth = ectx.Event.depth+1;
+ Event.sinfo = sinfo;
+ Event.step = ectx.Event.step;
+ Event.nb = n;
+ Event.data = datal;
+ Event.next = (fun () -> do_gaol soc_tbl ectx gaol val_ctx cont2);
+ }
+
+
+ with Not_found -> cont ectx val_ctx
+ )
+ | Call(vel_out, Assign, vel_in, lxm) -> (
+ assert (List.length vel_in = List.length vel_out);
+ (*
+ let val_ctx =
+ assert (List.length vel_in = List.length vel_out);
+ 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
- cont ectx val_ctx
- )
-and (do_soc_step : Lxm.t -> Lv6Id.t -> 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");
- 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
+ fcont ectx val_ctx
+ )
+ | Call(vel_out, Procedure sk, vel_in, lxm) -> (
+ let (proc_name,_,_) = sk in
+ let path_saved = val_ctx.cpath in
+ let val_ctx = { val_ctx with cpath = proc_name::val_ctx.cpath } in
+ let soc = SocUtils.find lxm sk soc_tbl in
+ let step = match soc.step with [step] -> step | _ -> assert false 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 }
+ let val_ctx = { val_ctx with cpath = path_saved } in
+ cont ectx val_ctx
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 step_name = match soc.step with
- [_] -> soc_name
- | _ -> soc_name^"."^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 -> []
+ let cont ectx val_ctx =
+ do_soc_step lxm proc_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
in
- let sinfo_subst arg var =
- match arg with
- | Var v -> v,var
- | Const v -> v,var
- | Field (_,_,t)
- | Index (_,_,t)
- | Slice (_,_,_,_,_,t) -> (SocUtils.string_of_filter arg, t), var
+ cont ectx val_ctx
+ )
+ | Call(vel_out, Method((inst_name,sk),step_name), vel_in, lxm) -> (
+ let path_saved = val_ctx.cpath in
+ let val_ctx = { val_ctx with cpath = inst_name::val_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 soc_step_in, soc_step_out = step.profile in *)
- let sinfo =
- let l = Lxm.line lxm in
- if l <= 0 then None else
- Some(fun () ->
- let atom =
- {
- Event.str = Lxm.str lxm;
- Event.file = Lxm.file lxm ;
- Event.line = Lxm.line lxm ,Lxm.line lxm ;
- Event.char = Lxm.cstart lxm, Lxm.cend lxm;
- Event.stack =
- match ectx.Event.sinfo with
- | None -> None
- | Some si -> Some (List.hd ((si()).Event.atoms));
- }
- in
- {
- Event.expr = Expr.Var "dummy" ; (* XXX *)
- Event.atoms = [atom];
- Event.more = None; (* yet *)
- Event.in_subst = List.map2 sinfo_subst vel_in step_in_vars;
- Event.out_subst = List.map2 sinfo_subst vel_out step_out_vars;
- }
- )
+ let cont ectx val_ctx =
+ let val_ctx = { val_ctx with cpath = path_saved } in
+ cont ectx val_ctx
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;
- }
+ let cont ectx val_ctx =
+ do_soc_step lxm inst_name step val_ctx soc_tbl soc vel_in vel_out ectx cont
in
- let cont2 local_ectx val_ctx =
-(* let (datal:Data.subst list) = List.map
+ cont ectx val_ctx
+ )
+and (do_soc_step : Lxm.t -> Lv6Id.t -> 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");
+ 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 step_name = match soc.step with
+ [_] -> soc_name
+ | _ -> soc_name^"."^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 -> []
+ 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
+ (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 (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.nb = local_ectx.Event.nb;
- Event.depth = ectx.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.sinfo = sinfo;
- Event.data = datal;
- Event.next = (fun () -> cont nectx val_ctx);
- Event.terminate = ectx.Event.terminate;
- }
- 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.nb = ectx.Event.nb;
+ Event.nb = local_ectx.Event.nb;
Event.depth = ectx.Event.depth;
- Event.kind = Event.Call;
+ 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.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.data = datal;
+ 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 = 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;
+ }
(* 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
(* End of XXX duplication of SocExec ! *)
(****************************************************************************)
-
+
(* exported *)
and (do_step_dbg : Soc.tbl -> Soc.t -> Event.t -> SocExecValue.ctx ->
- (Event.t -> SocExecValue.ctx -> Event.t) -> Event.t) =
+ (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_input_vals val_ctx soc_in_vars in
- let (soc_name,_,_) = soc.key in
- let lxm = (List.hd soc.step).lxm 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 -> []
- in
- let sinfo =
- Some(fun () ->
- let atom =
- {
- Event.str = soc_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 "dummy" ; (* XXX *)
- Event.atoms = [atom];
- Event.more = None; (* yet *)
- Event.in_subst = [];
- Event.out_subst = [];
- }
- )
- in
- let ectx = {
- ectx with
- Event.name = soc_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 =
- (* je pourrais enlver les entrées... *)
- let (datal:Data.subst list) = SocExecValue.get_vals val_ctx in
- let nectx = { ectx with
- Event.nb = local_ectx.Event.nb+1;
- Event.data = datal;
- Event.depth = ectx.Event.depth-1;
- }
- in
- {
- Event.step = ectx.Event.step;
- Event.nb = local_ectx.Event.nb;
- Event.depth = ectx.Event.depth;
- Event.kind = Event.Exit;
- Event.lang = "lustre";
- Event.name = soc_name;
- Event.inputs = fst soc.profile;
- Event.outputs = snd soc.profile;
- Event.locals = locals;
- Event.sinfo = sinfo;
- Event.data = datal;
- Event.next = (fun () -> cont nectx val_ctx);
- Event.terminate = ectx.Event.terminate;
- }
+ 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_input_vals val_ctx soc_in_vars in
+ let (soc_name,_,_) = soc.key in
+ let lxm = (List.hd soc.step).lxm 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 -> []
+ in
+ let sinfo =
+ Some(fun () ->
+ let atom =
+ {
+ Event.str = soc_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 "dummy" ; (* XXX *)
+ Event.atoms = [atom];
+ Event.more = None; (* yet *)
+ Event.in_subst = [];
+ Event.out_subst = [];
+ }
+ )
+ in
+ let ectx = {
+ ectx with
+ Event.name = soc_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 =
+ (* je pourrais enlver les entrées... *)
+ let (datal:Data.subst list) = SocExecValue.get_vals val_ctx in
+ let nectx = { ectx with
+ Event.nb = local_ectx.Event.nb+1;
+ Event.data = datal;
+ Event.depth = ectx.Event.depth-1;
+ }
in
{
Event.step = ectx.Event.step;
- Event.nb = ectx.Event.nb;
+ Event.nb = local_ectx.Event.nb;
Event.depth = ectx.Event.depth;
- Event.kind = Event.Call;
+ Event.kind = Event.Exit;
Event.lang = "lustre";
Event.name = soc_name;
- Event.inputs = ectx.Event.inputs;
- Event.outputs = ectx.Event.outputs;
+ Event.inputs = fst soc.profile;
+ Event.outputs = snd soc.profile;
Event.locals = locals;
Event.sinfo = sinfo;
- Event.data = ectx.Event.data;
- Event.next = (fun () ->
- let step = match soc.step with [step] -> step | _ -> assert false in
- let ectx = Event.incr_event_nb ectx in
- soc_step step.lxm step soc_tbl soc ectx val_ctx cont2
- );
+ Event.data = datal;
+ 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 = soc_name;
+ Event.inputs = ectx.Event.inputs;
+ Event.outputs = ectx.Event.outputs;
+ Event.locals = locals;
+ Event.sinfo = sinfo;
+ Event.data = ectx.Event.data;
+ Event.next = (fun () ->
+ let step = match soc.step with [step] -> step | _ -> assert false in
+ let ectx = Event.incr_event_nb ectx in
+ soc_step step.lxm step soc_tbl soc ectx val_ctx cont2
+ );
+ Event.terminate = ectx.Event.terminate;
+ }
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 2efbdf76b54f4df13c5f592de59f4ea253ddc31e..c7e6205e3a54900f8eb06317e33ff51ba4747132 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/08/2017 (at 18:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/09/2017 (at 16:45) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -38,16 +38,16 @@ let (soc_profile_of_types_nary : Data.t list -> var list * var list) =
List.tl inputs, ["out",Bool]
-let step11 str = { (* a useful alias again *)
+let step11 lxm str = { (* a useful alias again *)
name = "step";
- lxm = Lxm.dummy str;
+ lxm = lxm;
idx_ins = [0];
idx_outs = [0];
impl = Predef;
}
-let step21 impl str = { (* a useful alias again *)
+let step21 lxm impl str = { (* a useful alias again *)
name = "step";
- lxm = Lxm.dummy str;
+ lxm = lxm;
idx_ins = [0;1];
idx_outs = [0];
impl = Predef;
@@ -78,10 +78,10 @@ let (get_mem_name : Soc.key -> Data.t -> string) =
| _ -> "mem_"^k
*)
-let dummy = Lxm.dummy "predef"
+(* let dummy = Lxm.dummy "predef" *)
-let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t =
- fun init sk ->
+let of_fby_soc_key :Lxm.t -> Soc.var_expr -> Soc.key -> Soc.t =
+ fun lxm init sk ->
let _,tl,_ = sk in
let t = List.hd tl in
let pre_mem:var = (get_mem_name sk t, t) in
@@ -98,10 +98,10 @@ let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t =
(* faire qque chose de init maintenant !!! *)
{
name = "get";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [];
idx_outs = [0];
- impl = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)], dummy
+ impl = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)], lxm
)]);
(* impl = Gaol([pre_mem],[ *)
(* Case("$first_step", (["t", [Call([Var(vout)], Assign, [Var(v1)])]; *)
@@ -110,10 +110,10 @@ let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t =
};
{
name = "set";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [1];
idx_outs = [];
- impl = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v2)], dummy)]);
+ impl = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v2)], lxm)]);
};
];
precedences = ["set", ["get"]];
@@ -121,55 +121,55 @@ let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t =
}
(* exported *)
-let of_soc_key : Soc.key -> Soc.t =
- fun sk ->
+let of_soc_key : Lxm.t -> Soc.key -> Soc.t =
+ fun lxm sk ->
let (id, tl, _) = sk in
let sp = soc_profile_of_types in
let sp_nary = soc_profile_of_types_nary in
match id with
| "Lustre::ruminus"
| "Lustre::iuminus"
- | "Lustre::uminus" -> (make_soc sk (sp tl) [step11 id])
- | "Lustre::not" -> (make_soc sk (sp tl) [step11 id])
- | "Lustre::real2int" -> (make_soc sk (sp tl) [step11 id])
- | "Lustre::int2real" -> (make_soc sk (sp tl) [step11 id])
+ | "Lustre::uminus" -> (make_soc sk (sp tl) [step11 lxm id])
+ | "Lustre::not" -> (make_soc sk (sp tl) [step11 lxm id])
+ | "Lustre::real2int" -> (make_soc sk (sp tl) [step11 lxm id])
+ | "Lustre::int2real" -> (make_soc sk (sp tl) [step11 lxm id])
- | "Lustre::mod" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::mod" -> (make_soc sk (sp tl) [step21 lxm None id])
| "Lustre::iplus"
| "Lustre::rplus"
- | "Lustre::plus" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::plus" -> (make_soc sk (sp tl) [step21 lxm None id])
| "Lustre::times"
| "Lustre::itimes"
- | "Lustre::rtimes" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::rtimes" -> (make_soc sk (sp tl) [step21 lxm None id])
| "Lustre::slash"
| "Lustre::islash"
- | "Lustre::rslash" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::rslash" -> (make_soc sk (sp tl) [step21 lxm None id])
| "Lustre::div"
| "Lustre::idiv"
- | "Lustre::rdiv" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::rdiv" -> (make_soc sk (sp tl) [step21 lxm None id])
| "Lustre::minus"
| "Lustre::iminus"
- | "Lustre::rminus" -> (make_soc sk (sp tl) [step21 None id])
-
- | "Lustre::lt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::gt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::lte" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::gte" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::ilt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::igt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::ilte" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::igte" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::rlt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::rgt" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::rlte" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::rgte" -> (make_soc sk (sp tl) [step21 None id])
-
- | "Lustre::and" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::eq" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::neq" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::or" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::xor" -> (make_soc sk (sp tl) [step21 None id])
- | "Lustre::impl" -> (make_soc sk (sp tl) [step21 None id])
+ | "Lustre::rminus" -> (make_soc sk (sp tl) [step21 lxm None id])
+
+ | "Lustre::lt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::gt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::lte" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::gte" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::ilt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::igt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::ilte" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::igte" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::rlt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::rgt" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::rlte" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::rgte" -> (make_soc sk (sp tl) [step21 lxm None id])
+
+ | "Lustre::and" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::eq" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::neq" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::or" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::xor" -> (make_soc sk (sp tl) [step21 lxm None id])
+ | "Lustre::impl" -> (make_soc sk (sp tl) [step21 lxm None id])
(* Those have instances *)
| "Lustre::current" -> (
@@ -192,7 +192,7 @@ let of_soc_key : Soc.key -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0;1];
idx_outs = [0];
impl =
@@ -200,9 +200,9 @@ let of_soc_key : Soc.key -> Soc.t =
[Case((fst cv),[
(Lv6Id.string_of_long false cc, [Call([Var(mem)],
Assign, [Var(vin)],
- dummy)])],
- dummy);
- Call([Var(vout)], Assign, [Var(mem)], dummy )])
+ lxm)])],
+ lxm);
+ Call([Var(vout)], Assign, [Var(mem)], lxm )])
};
];
precedences = [];
@@ -224,20 +224,20 @@ let of_soc_key : Soc.key -> Soc.t =
step = [
{
name = "get";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [];
idx_outs = [0];
(* impl = Predef; *)
- impl = Gaol([],[Call([Var(vout)], Assign, [Var(pre_mem)], dummy)]);
+ impl = Gaol([],[Call([Var(vout)], Assign, [Var(pre_mem)], lxm)]);
(*impl = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)])]); *)
};
{
name = "set";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0];
idx_outs = [];
(* impl = Predef; *)
- impl = Gaol([],[Call([Var(pre_mem)], Assign, [Var(v1)], dummy )]);
+ impl = Gaol([],[Call([Var(pre_mem)], Assign, [Var(v1)], lxm )]);
(* impl = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v1)])]); *)
};
];
@@ -253,7 +253,7 @@ let of_soc_key : Soc.key -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0;1];
idx_outs = [0];
impl = Predef;
@@ -274,7 +274,7 @@ let of_soc_key : Soc.key -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0; 1; 2];
idx_outs = [0];
impl = Predef;
@@ -296,7 +296,7 @@ let of_soc_key : Soc.key -> Soc.t =
Soc.step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0];
idx_outs = [0];
impl = Boolred(0, 0, size);
@@ -322,7 +322,7 @@ let of_soc_key : Soc.key -> Soc.t =
Soc.step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0];
idx_outs = [0];
impl = Boolred(0,1, size);
@@ -389,8 +389,8 @@ let instanciate_soc: Soc.t -> Data.t -> Soc.t =
idem pour "x^n" (Hat_n).
*)
-let make_array_slice_soc : Lic.slice_info -> int -> Data.t -> Soc.t =
- fun si s t ->
+let make_array_slice_soc : Lxm.t -> Lic.slice_info -> int -> Data.t -> Soc.t =
+ fun lxm si s t ->
let size = si.Lic.se_width in
let array_type_in = Array(t,s) in
let array_type_out = Array(t,size) in
@@ -403,7 +403,7 @@ let make_array_slice_soc : Lic.slice_info -> int -> Data.t -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0];
idx_outs = [0];
impl = Predef;
@@ -414,8 +414,8 @@ let make_array_slice_soc : Lic.slice_info -> int -> Data.t -> Soc.t =
memory = No_mem;
}
-let make_array_soc: int -> Data.t -> Soc.t =
- fun i t ->
+let make_array_soc: Lxm.t -> int -> Data.t -> Soc.t =
+ fun lxm i t ->
let iprof =
let res = ref [] in
for k=i downto 1 do
@@ -432,7 +432,7 @@ let make_array_soc: int -> Data.t -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = SocUtils.gen_index_list i;
idx_outs = [0];
impl = Predef;
@@ -444,8 +444,8 @@ let make_array_soc: int -> Data.t -> Soc.t =
}
-let make_array_concat_soc: int -> int -> Data.t -> Soc.t =
- fun s1 s2 t ->
+let make_array_concat_soc: Lxm.t -> int -> int -> Data.t -> Soc.t =
+ fun lxm s1 s2 t ->
let iprof = (["i1", Array(t,s1); "i2", Array(t,s2)], ["out", Array(t,s1+s2)])in
let key_prof = [Array(t,s1); Array(t,s2); Array(t,s1+s2)] in
{
@@ -455,7 +455,7 @@ let make_array_concat_soc: int -> int -> Data.t -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm;
idx_ins = [0;1];
idx_outs = [0];
impl = Predef;
@@ -466,8 +466,8 @@ let make_array_concat_soc: int -> int -> Data.t -> Soc.t =
memory = No_mem;
}
-let make_hat_soc: int -> Data.t -> Soc.t =
- fun i t ->
+let make_hat_soc: Lxm.t -> int -> Data.t -> Soc.t =
+ fun lxm i t ->
let array_type =
match t with
| Data.Alpha _ -> assert false
@@ -480,7 +480,7 @@ let make_hat_soc: int -> Data.t -> Soc.t =
step = [
{
name = "step";
- lxm = Lxm.dummy "predef";
+ lxm = lxm ;
idx_ins = [0];
idx_outs = [0];
impl = Predef;
@@ -523,51 +523,51 @@ let (soc_interface_of_pos_op:
| Lic.PREDEF_CALL ({Lxm.it=("Lustre","if"),[]}),_ ,_ ->
let concrete_type = List.nth types 1 in
- let soc = of_soc_key ("Lustre::if", types@[concrete_type], Nomore) in
+ let soc = of_soc_key lxm ("Lustre::if", types@[concrete_type], Nomore) in
instanciate_soc soc concrete_type
| Lic.PREDEF_CALL {Lxm.it=(op,sargs)}, _, _ ->
assert (sargs=[]);
let soc_name = Lv6Id.string_of_long false op in
let out_type = output_type_of_op soc_name types in
- let soc = of_soc_key (soc_name, types@[out_type], Nomore) in
+ let soc = of_soc_key lxm (soc_name, types@[out_type], Nomore) in
soc
| Lic.FBY, _, Some init ->
let concrete_type = List.nth types 0 in
- let soc = of_fby_soc_key init (("Lustre::fby"),
+ let soc = of_fby_soc_key lxm init (("Lustre::fby"),
types@[concrete_type], MemInit init) in
instanciate_soc soc concrete_type
| Lic.FBY, _, None -> assert false (* should ot occur *)
| Lic.PRE, _, _ ->
let concrete_type = List.nth types 0 in
- let soc = of_soc_key (("Lustre::pre"), types@[concrete_type], Nomore) in
+ let soc = of_soc_key lxm (("Lustre::pre"), types@[concrete_type], Nomore) in
instanciate_soc soc concrete_type
| Lic.CURRENT (Some(cc)), _, _ ->
let concrete_type = try List.nth types 1 with _ -> assert false in
- let soc = of_soc_key (("Lustre::current"), types@[concrete_type], Curr(cc)) in
+ let soc = of_soc_key lxm (("Lustre::current"), types@[concrete_type], Curr(cc)) in
instanciate_soc soc concrete_type
| Lic.CURRENT (_), _, _ -> assert false (* sno *)
| Lic.ARROW, _, _ ->
let concrete_type = List.nth types 0 in
- let soc = of_soc_key (("Lustre::arrow"), types@[concrete_type],
+ let soc = of_soc_key lxm (("Lustre::arrow"), types@[concrete_type],
MemInit(Const("_true", Data.Bool)))
in
let soc = instanciate_soc soc concrete_type in
soc
| Lic.HAT i,_, _ ->
let elt_type = List.nth types 0 in
- (make_hat_soc i elt_type)
+ (make_hat_soc lxm i elt_type)
| Lic.ARRAY, _, _ ->
let elt_type = List.nth types 0 in
let i = (List.length types) in
- (make_array_soc i elt_type)
+ (make_array_soc lxm i elt_type)
- | Lic.ARRAY_SLICE sinfo, [Array (t, s)], _ -> (make_array_slice_soc sinfo s t)
+ | Lic.ARRAY_SLICE sinfo, [Array (t, s)], _ -> (make_array_slice_soc lxm sinfo s t)
| Lic.ARRAY_SLICE sinfo, _, _ -> assert false
| Lic.CONCAT, [Array (t1, s1); Array (t2, s2)], _->
assert (t1=t2);
- (make_array_concat_soc s1 s2 t1)
+ (make_array_concat_soc lxm s1 s2 t1)
| Lic.CONCAT , _, _ -> assert false
| Lic.CALL _,_,_ -> assert false
diff --git a/src/socPredef.mli b/src/socPredef.mli
index df6da2e74e244776293e90a03b68cf9084a1f78c..2922410ee8c9e096993d791281f9ec3a2ca78477 100644
--- a/src/socPredef.mli
+++ b/src/socPredef.mli
@@ -1,9 +1,9 @@
-(* Time-stamp: <modified the 07/01/2015 (at 16:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/09/2017 (at 16:32) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
-val of_soc_key : Soc.key -> Soc.t
+val of_soc_key : Lxm.t -> Soc.key -> Soc.t
(** Associe un opérateur Lustre et le type de ses opérandes à un SOC
et sa fonction de typage.
diff --git a/src/socUtils.ml b/src/socUtils.ml
index a2404578783b363a1d2472f474fc75fc03dfb3bc..3b1bcfb6ac657825361b19b448c21940a14ef4a7 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/07/2017 (at 15:30) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/09/2017 (at 17:02) by Erwan Jahier> *)
open Soc
@@ -360,7 +360,17 @@ let (ctx_is_global : Soc.t -> bool) =
| Lv6MainArgs.Heap -> is_memory_less soc
| Lv6MainArgs.Stack | Lv6MainArgs.HeapStack -> false
-
+let (get_rank : 'a -> ('a * 'b) list -> int) =
+ fun x l ->
+ let rec aux i l =
+ match l with
+ | [] -> 0
+ | (y,_)::l -> if x = y then i else aux (i+1) l
+ in
+ aux 1 l
+
+let _ = assert (get_rank 5 [(1,4);(3,4);(5,5)] = 3)
+
let (filter_step_params : int list -> 'a list -> 'a list) =
fun il vl -> (* we suppose that the index list is in increasing order *)
diff --git a/src/socUtils.mli b/src/socUtils.mli
index 4b35a4304750c3992608d3a3c705803899d6f003..83531dc7f0365c81a8941a05ddf4db23d482ccf8 100644
--- a/src/socUtils.mli
+++ b/src/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 03/07/2017 (at 10:22) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/09/2017 (at 17:02) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -69,3 +69,5 @@ filter_step_params [0;1;4] [v1;v2;v3;v4;v5] = [v1;v2;v5]
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
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index c263d411d313f8cf69d5ed36a026fe1633d0566c..e04bfcb2844583afa396b6338103647f8604257a 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test Run By jahier on Mon Aug 28 17:05:56
+Test Run By jahier on Fri Sep 8 10:38:01
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 Aug 28 17:05:57
+Test Run By jahier on Fri Sep 8 10:38:01
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 Aug 28 17:06:49
+Test Run By jahier on Fri Sep 8 10:38:55
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 Aug 28 17:07:47
+Test Run By jahier on Fri Sep 8 10:39:54
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 Aug 28 17:09:00
+Test Run By jahier on Fri Sep 8 10:41:11
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 0 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 52 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 58 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 73 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 46 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
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 47 seconds
* Ref time:
-0.06user 0.00system 3:51.51elapsed 0%CPU (0avgtext+0avgdata 5588maxresident)k
-0inputs+0outputs (0major+6187minor)pagefaults 0swaps
+0.07user 0.00system 3:57.18elapsed 0%CPU (0avgtext+0avgdata 5692maxresident)k
+32inputs+0outputs (0major+6203minor)pagefaults 0swaps
* Quick time (-j 4):
-0.05user 0.02system 1:58.38elapsed 0%CPU (0avgtext+0avgdata 5704maxresident)k
-0inputs+0outputs (0major+6193minor)pagefaults 0swaps
+0.05user 0.02system 1:41.39elapsed 0%CPU (0avgtext+0avgdata 5608maxresident)k
+32inputs+0outputs (0major+6183minor)pagefaults 0swaps