Skip to content
Snippets Groups Projects
Commit d98667f2 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

The -exec mode now supports the condact statement.

parent d2088fee
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/lic2soc.ml
+ 75
− 50
View file @ d98667f2
(** 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) =
......
src/licMetaOp.ml
+ 22
− 2
View file @ d98667f2
(* 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 =
......
src/soc.ml
+ 2
− 1
View file @ d98667f2
(* 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;
......
src/socExec.ml
+ 43
− 3
View file @ d98667f2
(* 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 };
......
src/socUtils.ml
+ 2
− 1
View file @ d98667f2
(** 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@;";
......
test/lus2lic.sum
+ 1
− 1
View file @ d98667f2
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 ===
......
test/lus2lic.time
+ 1
− 1
View file @ d98667f2
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
todo.org
+ 4
− 6
View file @ d98667f2
......@@ -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
......
todo.org_archive
+ 32
− 0
View file @ d98667f2
......@@ -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:
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment