From d98667f2e80950bfa8f430d75c63d15b975e19a7 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 5 Apr 2013 18:22:07 +0200
Subject: [PATCH] The -exec mode now supports the condact statement.
---
src/lic2soc.ml | 125 +++++++++++++++++++++++++++-------------------
src/licMetaOp.ml | 24 ++++++++-
src/soc.ml | 3 +-
src/socExec.ml | 46 +++++++++++++++--
src/socUtils.ml | 3 +-
test/lus2lic.sum | 2 +-
test/lus2lic.time | 2 +-
todo.org | 10 ++--
todo.org_archive | 32 ++++++++++++
9 files changed, 182 insertions(+), 65 deletions(-)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index ba79c790..679a0653 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/04/2013 (at 10:54) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/04/2013 (at 18:21) by Erwan Jahier> *)
open Lxm
open Lic
@@ -626,10 +626,11 @@ let (actions_of_equation: Lxm.t -> Soc.tbl -> ctx -> Lic.eq_info ->
(* let deps = add deps final_action actions in *)
ctx, actions, instances, deps
-
-
(*********************************************************************************)
open Soc
+
+(*********************************************************************************)
+
let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
fun prog mnk ->
let rec (process_node : Lic.node_key -> Soc.tbl -> Soc.key * Soc.tbl) =
@@ -701,6 +702,37 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
)
in
sk, soc_tbl
+
+ and make_condact_soc node condact_node soc_key soc_tbl ctx lxm vel =
+ let nsk, soc_tbl = process_node condact_node soc_tbl in
+ let nsoc = SocUtils.find lxm nsk soc_tbl in
+ let nsoc_step = match nsoc.step with [s] -> s
+ | _ -> assert false (* hmm. Iterating on a pre will not work. XXX fixme ! *)
+ in
+ let ctx,inst =
+ match make_instance lxm Lic.BaseLic ctx nsoc with
+ | ctx,Some inst -> ctx,[inst]
+ | ctx,None -> ctx,[]
+ in
+ let soc = {
+ Soc.key = soc_key;
+ Soc.profile = soc_profile_of_node node;
+ Soc.instances = inst ;
+ Soc.step = [
+ {
+ name = "step";
+ lxm = lxm;
+ idx_ins = nsoc_step.idx_ins@[List.length nsoc_step.idx_ins];
+ idx_outs = nsoc_step.idx_outs;
+ impl = Condact(nsk, List.flatten (List.map lic2soc_const vel));
+ }
+ ];
+ Soc.have_mem = None;
+ Soc.precedences = [];
+ }
+ in
+ soc_tbl, soc
+
(** Produit des soc de noeuds. *)
and (soc_of_node: LicPrg.t -> Lic.node_exp -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun licprg node soc_tbl ->
@@ -753,10 +785,12 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
in
let (soc_of_metaop: Lic.node_key -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun nk soc_tbl ->
- match List.sort compare (snd nk) with
- | [ConstStaticArgLic(_,Int_const_eff(c)); NodeStaticArgLic(_,iter_node)]
- | [ConstStaticArgLic(_,Int_const_eff(c)); TypeStaticArgLic(_);
- NodeStaticArgLic(_,iter_node)] -> ( (*red, fill, fillred, map *)
+ match snd (fst nk), List.sort compare (snd nk) with
+ | ("map"|"red"|"fill"|"fillred"|"fold"),[
+ ConstStaticArgLic(_,Int_const_eff(c)); NodeStaticArgLic(_,iter_node)]
+ | ("map"|"red"|"fill"|"fillred"|"fold"),[
+ ConstStaticArgLic(_,Int_const_eff(c)); TypeStaticArgLic(_);
+ NodeStaticArgLic(_,iter_node)] -> ( (*red, fill, fillred, map *)
let nsk, soc_tbl = process_node iter_node soc_tbl in
let nsoc = SocUtils.find lxm nsk soc_tbl in
let nsoc_step = match nsoc.step with [s] -> s
@@ -788,53 +822,44 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
}
in
Some(ctx, soc, soc_tbl)
- )
- | _ ->
+ )
+ | ("condact"), [
+ ConstStaticArgLic("dflt",Tuple_const_eff vel);NodeStaticArgLic("oper",condact_node)
+ ] -> (
+ let soc_tbl,soc = make_condact_soc node condact_node soc_key soc_tbl ctx lxm vel in
+ Some(ctx, soc, soc_tbl)
+ )
+ | ("condact"), [
+ ConstStaticArgLic("dflt",const); NodeStaticArgLic ("oper",condact_node)
+ ] -> (
+ let soc_tbl,soc = make_condact_soc node condact_node soc_key soc_tbl ctx lxm [const] in
+ Some(ctx, soc, soc_tbl)
+ )
+ | e ->
match (nk) with
- | ("Lustre","condact"), sargs -> (
-
- let soc = {
- Soc.key = soc_key;
- Soc.profile = soc_profile_of_node node;
- Soc.instances = [] ;
- Soc.step = [
- {
- name = "step";
- lxm = lxm;
- idx_ins = [0];
- idx_outs = [0];
- impl = Predef;
- }
- ];
- Soc.have_mem = None;
- Soc.precedences = [];
- }
- in
- Some(ctx, soc, soc_tbl)
- )
| ("Lustre","boolred"), [ConstStaticArgLic(_,Int_const_eff(i));
ConstStaticArgLic(_,Int_const_eff(j));
ConstStaticArgLic(_,Int_const_eff(k)) ] -> (
- let i,j,k = int_of_string i, int_of_string j, int_of_string k in
- let soc = {
- Soc.key = soc_key;
- Soc.profile = soc_profile_of_node node;
- Soc.instances = [] ;
- Soc.step = [
- {
- name = "step";
- lxm = lxm;
- idx_ins = [0];
- idx_outs = [0];
- impl = Boolred(i,j,k);
- }
- ];
- Soc.have_mem = None;
- Soc.precedences = [];
- }
- in
- Some(ctx, soc, soc_tbl)
- )
+ let i,j,k = int_of_string i, int_of_string j, int_of_string k in
+ let soc = {
+ Soc.key = soc_key;
+ Soc.profile = soc_profile_of_node node;
+ Soc.instances = [] ;
+ Soc.step = [
+ {
+ name = "step";
+ lxm = lxm;
+ idx_ins = [0];
+ idx_outs = [0];
+ impl = Boolred(i,j,k);
+ }
+ ];
+ Soc.have_mem = None;
+ Soc.precedences = [];
+ }
+ in
+ Some(ctx, soc, soc_tbl)
+ )
| _ -> assert false
in
let (soc_of_extern: Lic.node_exp -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
diff --git a/src/licMetaOp.ml b/src/licMetaOp.ml
index 3f841649..dc56a078 100644
--- a/src/licMetaOp.ml
+++ b/src/licMetaOp.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 29/03/2013 (at 16:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/04/2013 (at 14:02) by Erwan Jahier> *)
(* *)
@@ -127,7 +127,27 @@ and do_fillred nk2nd nk lxm =
- A (tuple) const: b_1 * ... * b_k
Gen a node of type : bool * a_1 * ... * a_n -> b_1 * ... * b_k
---------------------------------------------------------------------*)
-and do_condact nk2nd nk lxm =
+(*
+nb :
+
+node condact_xx(c,i1,...,in) returns(res1,...,resk);
+let
+ res1,...,resk = condact<<node,(dft_res1,...,dft_resk)>>(c,i1,...,in)
+tel
+
+could be translated into
+
+node condact_xx(c,i1,...,in) returns(res1,...,resk);
+let
+res1,...,resk =
+ merge c (true -> node(i1,...,in))
+ (false -> (dft_res1,...,dft_resk) fby (res1,...,resk)
+tel
+
+is it a good idea?
+*)
+and (do_condact : (Lic.node_key -> Lic.node_exp) -> node_key -> Lxm.t -> Lic.node_exp) =
+fun nk2nd nk lxm ->
try
let sargs = snd nk in
let np, dflt =
diff --git a/src/soc.ml b/src/soc.ml
index 443a7441..6c2aad7b 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 02/04/2013 (at 15:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/04/2013 (at 14:31) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -55,6 +55,7 @@ type step_impl =
| Gaol of var list * gao list (* local vars + body *)
| Iterator of string * key * int (* iterator, iterated soc key, size *)
| Boolred of int * int * int
+ | Condact of key * var_expr list (* condact-ed node, default constants *)
type step_method = {
name : ident;
diff --git a/src/socExec.ml b/src/socExec.ml
index eaeb2e5d..b731fe26 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/04/2013 (at 10:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/04/2013 (at 18:24) by Erwan Jahier> *)
open Soc
open SocExecValue
@@ -7,6 +7,9 @@ let dbg = Some(Verbose.get_flag "exec")
let (assign_expr : ctx -> var_expr -> var_expr -> ctx) =
fun ctx ve_in ve_out -> (* ve_out := ve_in (in ctx) *)
+ Verbose.exe ~flag:dbg
+ (fun () -> print_string ("Assigning "^(SocUtils.string_of_filter ve_out) ^
+ "to " ^(SocUtils.string_of_filter ve_in) ^ "\n"); flush stdout);
{ ctx with s =
let v = SocExecValue.get_value ctx ve_in in
sadd_partial ctx.s ve_out ctx.cpath v
@@ -48,6 +51,43 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
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 ("i0",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 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 = { ctx with s = sadd ctx.s ("first_step"::ctx.cpath) (B 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 ("first_step",Bool) in
+ let v = get_value ctx first_step in
+ if v <> U then
+ (* We are not on the first step of node_soc; hence we do nothing
+ and the output will keep their previous value.
+ *)
+ { ctx with cpath=path_saved }
+ else
+ (* We are on the first step of node_soc;
+ - we assign the output var to the default values
+ *)
+ let ctx = { ctx with cpath=path_saved } in
+ List.fold_left2 assign_expr ctx dft_cst vel_out
+ 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
@@ -56,8 +96,8 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
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)
+ | [] -> 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 };
diff --git a/src/socUtils.ml b/src/socUtils.ml
index de0bcd0a..e2610b96 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/04/2013 (at 11:07) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/04/2013 (at 14:24) by Erwan Jahier> *)
open Soc
@@ -177,6 +177,7 @@ let string_of_method_ff: (Soc.t -> step_method -> Format.formatter -> unit) = fu
| Predef -> fprintf ff "@]@]"
| Boolred _ -> assert false (* todo *)
| Iterator _ -> assert false (* todo *)
+ | Condact _ -> assert false (* todo *)
| Gaol (locals, gaos) ->
fprintf ff ": {@;";
fprintf ff "@[<v>-- locals vars@;";
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 5f441c63..209a5951 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Fri Apr 5 13:35:01 2013
+Test Run By jahier on Fri Apr 5 17:15:01 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index b366218f..152bda03 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 27 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 66 seconds
testcase ./lus2lic.tests/progression.exp completed in 0 seconds
diff --git a/todo.org b/todo.org
index 13bcaed9..9a82719f 100644
--- a/todo.org
+++ b/todo.org
@@ -35,16 +35,14 @@ que de lancer luciole
** TODO Traiter la fleche plus proprement.
- State "TODO" from "" [2013-04-02 Tue 08:33]
-** TODO condact
- - State "TODO" from "" [2013-03-19 Tue 10:33]
-** TODO fby
- - State "TODO" from "" [2013-04-04 Thu 17:10]
+En fait il me suffirait de m'inspirer de ce que j'ai fait dans le condact
+avec la variable "first_instant" !!!
+
+
** TODO Translate the fby properly into a soc
- State "TODO" from "" [2013-04-04 Thu 17:10]
vs "-> pre" as it is done actually in file:~/lus2lic/src/ast2lic.ml::468
-** TODO merge
- - State "TODO" from "" [2013-03-19 Tue 10:33]
** TODO slice
- State "TODO" from "" [2013-04-05 Fri 11:18]
** TODO fonctions externes
diff --git a/todo.org_archive b/todo.org_archive
index 56aef140..9d90f772 100644
--- a/todo.org_archive
+++ b/todo.org_archive
@@ -566,6 +566,38 @@ XXX essayer de virer le constructeur Oper qui n'a pas l'air de servir à grand c
:ARCHIVE_TODO: TODO
:END:
+* TODO merge
+ - State "TODO" from "" [2013-03-19 Tue 10:33]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-04-05 Fri 15:13
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: lus2lic -exec
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+* TODO fby
+ - State "TODO" from "" [2013-04-04 Thu 17:10]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-04-05 Fri 15:13
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: lus2lic -exec
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+
+* TODO condact
+ - State "TODO" from "" [2013-03-19 Tue 10:33]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-04-05 Fri 17:23
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: lus2lic -exec
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+
+
+
+
--
GitLab