diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 679a0653e2019d68d1c2323355a3c3a472677606..1330f0012a178fc1cac817f826774f94e40e8fd2 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/04/2013 (at 18:21) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 10:30) by Erwan Jahier> *)
open Lxm
open Lic
@@ -361,11 +361,6 @@ let (action_of_step : Lxm.t -> Soc.t -> Lic.clock -> Soc.var_expr list ->
Soc.var_expr list -> Soc.instance option -> Soc.step_method -> action) =
fun lxm c clk il ol mem step ->
let local_nth i l =
- if i < 0 then
- (* to handle the particular case of arrow. XXX just a crutch to make it works *)
- let mem_name = SocPredef.get_mem_name c.Soc.key Soc.Bool in
- Soc.Var(mem_name, Soc.Bool)
- else
try List.nth l i
with _ ->
print_string (
@@ -681,18 +676,6 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
);
let soc_tbl = SocMap.add soc.key soc soc_tbl in
let t = List.hd types in
- (* The arrow is translated into a if. So we make sure that the "if"
- is in the soc tbl *)
- let if_sk = "Lustre::if", [Bool;t;t], None in
- let soc_tbl =
- if pos_op = Lic.ARROW && not(SocMap.mem if_sk soc_tbl) then
- let soc = SocPredef.soc_interface_of_pos_op lxm
- (Lic.PREDEF_CALL ({ it=("Lustre","if"),[]; src=lxm})) [Bool;t;t]
- in
- SocMap.add soc.key soc soc_tbl
- else
- soc_tbl
- in
snd (process_node nk soc_tbl)
)
| Undef_merge_soc (sk, lxm, clk, case_l) -> (
diff --git a/src/soc.ml b/src/soc.ml
index 6c2aad7b3225f3f20202bef1bea7804eaef87257..bb110dbaa8eb8fe2100eea719bd8abbce80f844d 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/04/2013 (at 14:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:30) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -88,7 +88,7 @@ type t = {
the partial order defined in precedences *)
precedences : precedence list; (* partial order over step methods *)
have_mem : (var_type * var_expr option) option;
- (* Do this soc have a memory (pre, fby, arrow) + its type + default value *)
+ (* Do this soc have a memory (pre, fby) + its type + default value *)
}
(* SocKeyMap ? *)
diff --git a/src/socExec.ml b/src/socExec.ml
index b731fe2661c3bbae0074bd4ecf4fdef5521b6934..edf1e6292abd71497264681b900a71d73991685d 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/04/2013 (at 18:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
open Soc
open SocExecValue
@@ -9,7 +9,7 @@ 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);
+ " 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
@@ -38,6 +38,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
)
| Gaol(vl,gaol) -> List.fold_left (do_gao step.lxm soc_tbl) ctx gaol
| Boolred(i,j,k) -> (
+ (* XXX mettre ce code dans socPredef ? (ou socMetaopPredef)*)
let inputs, outputs = soc.profile in
let b_array = (List.hd inputs) in
let cpt = ref 0 in
@@ -54,7 +55,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
| 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_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 =
@@ -65,24 +66,22 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
in
let path_saved = ctx.cpath in
let ctx = { ctx with cpath=inst_name::ctx.cpath } in
- let ctx =
+ 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 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 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.
- *)
+ 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
- *)
+ - 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
@@ -112,6 +111,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
| _ -> assert false (* should not occur *)
in
rctx := do_step inst_name.(i) node_step !rctx soc_tbl node_soc vel_in vel_out;
+ rctx := { !rctx with cpath = List.tl !rctx.cpath };
done;
if iter <> "map" then (
let a_in = Var (List.hd iter_inputs) in
@@ -132,18 +132,25 @@ and (do_gao : Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx)
| Call(vel_out, Assign, vel_in) -> List.fold_left2 assign_expr ctx vel_in vel_out
| Call(vel_out, Procedure sk, vel_in) -> (
let (proc_name,_,_) = sk in
+ let path_saved = ctx.cpath in
let ctx = { ctx with cpath = proc_name::ctx.cpath } in
let soc = SocUtils.find lxm sk soc_tbl in
let step = match soc.step with [step] -> step | _ -> assert false in
- do_step proc_name step ctx soc_tbl soc vel_in vel_out
+ let ctx = do_step proc_name step ctx soc_tbl soc vel_in vel_out in
+ { ctx with cpath = path_saved }
)
| Call(vel_out, Method((inst_name,sk),step_name), vel_in) -> (
+ let path_saved = ctx.cpath in
let ctx = { ctx with cpath = inst_name::ctx.cpath } in
let soc = SocUtils.find lxm sk soc_tbl in
let step = try List.find (fun sm -> sm.name = step_name) soc.step
with Not_found -> assert false
in
- do_step inst_name step ctx soc_tbl soc vel_in vel_out
+ let ctx = do_step inst_name step ctx soc_tbl soc vel_in vel_out in
+ let ctx = { s = sadd ctx.s ("$first_step"::ctx.cpath) (B false);
+ cpath = path_saved }
+ in
+ ctx
)
and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
var_expr list -> var_expr list -> SocExecValue.ctx) =
@@ -154,18 +161,12 @@ and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
let new_s = substitute_args_and_params vel_in step_in_vars ctx in
let ctx = soc_step step soc_tbl soc { ctx with s=new_s } in
let s_out = substitute_params_and_args step_out_vars vel_out ctx in
- { s = s_out ; cpath = List.tl ctx.cpath }
-
+ { ctx with s = s_out }
(* get the step params from its soc params *)
and (filter_params : Soc.t -> Soc.var list -> int list -> Soc.var list) =
fun soc el il ->
let local_nth i l =
- if i < 0 then
- (* to handle the particular case of arrow. XXX just a crutch to make it works *)
- let mem_name = SocPredef.get_mem_name soc.Soc.key Soc.Bool in
- (mem_name, Soc.Bool)
- else
try List.nth l i
with _ ->
print_string (
@@ -290,6 +291,7 @@ let rec (loop_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> int -> out_channel
let ctx = { ctx with s = read_soc_input soc oc ctx.s } in
let step = match soc.step with [step] -> step | _ -> assert false in
let ctx = soc_step step soc_tbl soc ctx in
+ let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false)} in
(* dump_substs ctx.s; *)
let profile = expand_profile (snd soc.profile) in
let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index 3845855b39f015664321b59df8e144db82216317..552bc9fd68023080028fbf4bdaa849df5d1bcafa 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/04/2013 (at 10:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
open SocExecValue
open Soc
@@ -246,6 +246,17 @@ let lustre_current ctx =
in
{ ctx with s = sadd ctx.s vn vv }
+let lustre_arrow ctx =
+ let (vn,vv) =
+ match ([get_val "x" ctx; get_val "y" ctx;
+ get_val "$first_step" { ctx with cpath=List.tl ctx.cpath}])
+ with
+ | [v1;v2; fs] -> "z"::ctx.cpath, if fs=B false then v2 else v1
+ | _ -> assert false
+ in
+ { ctx with s = sadd ctx.s vn vv }
+
+
let lustre_hat tl ctx =
let i = match tl with
| [_;Soc.Array(_,i)] -> i
@@ -293,6 +304,7 @@ let (get: Soc.key -> (ctx -> ctx)) =
| "Lustre::array" -> lustre_array tl
| "Lustre::concat" -> lustre_concat
+ | "Lustre::arrow" -> lustre_arrow
| "Lustre::current" -> lustre_current
| "Lustre::merge" -> lustre_merge tl
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 1214e9e85ed6b90809630871906fc67bcd31ae28..da8095cb00b76b798d71d105f9954743b8b80587 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/04/2013 (at 13:30) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 10:43) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -168,10 +168,6 @@ let of_soc_key : Soc.key -> Soc.t =
}
| "Lustre::arrow" ->
let prof = sp tl in
- let v1,v2,vout = match prof with ([v1;v2],[vout]) -> v1,v2,vout | _ -> assert false in
- let _,tl,_ = sk in
- let t = List.hd tl in
- let pre_mem:var = (get_mem_name sk Bool, Bool) in
{
key = sk;
profile = prof;
@@ -182,59 +178,13 @@ let of_soc_key : Soc.key -> Soc.t =
lxm = Lxm.dummy "predef soc";
idx_ins = [0;1];
idx_outs = [0];
- impl = Gaol([],[Call([Var(vout)],
- Procedure ("Lustre::if",[Bool;t;t;t],None),
- [Var(pre_mem);Var(v1);Var(v2)])]);
- };
- {
- name = "update_first_instant";
- lxm = Lxm.dummy "predef soc";
- idx_ins = [];
- idx_outs = [-1];
- impl = Gaol([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
- };
+ impl = Predef;
+ }
];
- precedences = ["update_first_instant",["step"]];
- have_mem = Some (Bool, Some (Const("true",Bool)));
+ precedences = [];
+ have_mem = None;
}
| "Lustre::fby" -> assert false
-(* replace fby by '->' + 'pre' ?
- let _,tl,_ = sk in
- let t = List.hd tl in
- let pre_mem:var = (get_mem_name sk t, t) in
- let fi_mem:var = pre_mem^"_fi"
- let prof = sp tl in
- let v1,v2,vout = match prof with ([v1;v2],[vout]) -> v1,v2,vout | _ -> assert false in
- {
- key = sk;
- profile = (sp tl);
- instances = [];
- step = [
- {
- name = "get";
- lxm = Lxm.dummy "predef soc";
- idx_ins = [];
- idx_outs = [0];
- impl = Gaol([pre_mem],[Call([Var(vout)], Assign, [Var(pre_mem)])]);
- };
- {
- name = "set";
- lxm = Lxm.dummy "predef soc";
- idx_ins = [1];
- idx_outs = [];
- impl = Gaol([pre_mem],[Call([Var(pre_mem)], Assign, [Var(v1)])]);
- };
- {
- name = "update_first_instant";
- lxm = Lxm.dummy "predef soc";
- idx_ins = [];
- idx_outs = [-1];
- impl = Gaol([],[Call([Var(pre_mem)], Assign, [Const("false",Bool)])]);
- };
- ];
- precedences = ["set", ["get"];"update_first_instant",["set"]];
- have_mem = Some (Bool, Some (Const("true",Bool)));
- } *)
| "Lustre::if" -> {
key = sk;
profile = (sp tl);
@@ -560,7 +510,7 @@ let (soc_interface_of_pos_op:
(*
21/02/2013 : ai-je vraiment besoin de ca maintenant que les metaop ont été encapsulé
-dans des noeuds ? bon, je garde quelque temps en commentaire au cas ou...
+ dans des noeuds ? bon, je garde quelque temps en commentaire au cas ou...
| Lic.Fill(node,size), _
| Lic.FillRed(node,size), _
| Lic.Red(node,size), _ ->
diff --git a/todo.org b/todo.org
index 9a82719fc3d6963a14601aa4ae1d95f03e8bbcfb..11061f4f67ebbe7574b4d13f6bca8e0ab9bacd3f 100644
--- a/todo.org
+++ b/todo.org
@@ -38,7 +38,6 @@ que de lancer luciole
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