diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index 39dc6dc2d2648767dfca27463ef52349c9653fb8..fe26175cbb72a96c7d20bd7d3784dfbd09f212ee 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 02/04/2013 (at 16:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:13) by Erwan Jahier> *)
open Lxm
@@ -355,8 +355,10 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
| _ ->
let s, vef_core, lxm =
match ve with
- | Merge_n(id, cl) ->
- let lxm_ve = id.src in
+ | Merge_n(ve, cl) ->
+ let lxm_ve = ve.src in
+ let ve = ve.it in
+ let s,ve = translate_val_exp id_solver s ve in
let s, cl =
List.fold_left
(fun (s,cl) (id,ve) ->
@@ -367,14 +369,16 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
(s, [])
cl
in
- s, Lic.Merge(id, List.rev cl), lxm_ve
- | Merge_bool_n(id, t, f) ->
- let lxm_ve = id.src in
+ s, Lic.Merge(ve, List.rev cl), lxm_ve
+ | Merge_bool_n(ve, t, f) ->
+ let lxm_ve = ve.src in
+ let ve = ve.it in
+ let s,ve = translate_val_exp id_solver s ve in
let s,case_true = translate_val_exp id_solver s t in
let s,case_false = translate_val_exp id_solver s f in
let case_true = (flagit (Bool_const_eff true) lxm_ve, case_true) in
let case_false = (flagit (Bool_const_eff false) lxm_ve, case_false) in
- s, Lic.Merge(id, [case_true; case_false]), lxm_ve
+ s, Lic.Merge(ve, [case_true; case_false]), lxm_ve
| CallByName(by_name_op, field_list) ->
let s,fl = List.fold_left
diff --git a/src/astCore.ml b/src/astCore.ml
index 2a21a6b138886e1652846c235378e809245a1559..9d82cf514396a7a79354bf9992463aca9693a850 100644
--- a/src/astCore.ml
+++ b/src/astCore.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/02/2013 (at 16:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:10) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source Lustre Core programs. *)
@@ -124,8 +124,8 @@ and by_pos_op =
and val_exp =
| CallByPos of (by_pos_op srcflagged * operands)
| CallByName of (by_name_op srcflagged * (Ident.t srcflagged * val_exp) list)
- | Merge_n of Ident.t srcflagged * (Ident.idref srcflagged * val_exp) list
- | Merge_bool_n of Ident.t srcflagged * val_exp * val_exp
+ | Merge_n of val_exp srcflagged * (Ident.idref srcflagged * val_exp) list
+ | Merge_bool_n of val_exp srcflagged * val_exp * val_exp
and operands = Oper of val_exp list
(* Virer cet Oper ? Non, sinon ca boucle... *)
@@ -212,5 +212,5 @@ let string_of_var_nature = function
let lxm_of_val_exp = function
| CallByPos(op,_) -> op.src
| CallByName(op,_) -> op.src
- | Merge_n(id,_)
+ | Merge_n(ve,_) -> ve.src
| Merge_bool_n(id,_,_) -> id.src
diff --git a/src/astV6Dump.ml b/src/astV6Dump.ml
index f21d6bc9eb2a72dbc995187cf00a3563989ed5b0..7e2a0712832e31e4d36308898c3f3648d8e19f6a 100644
--- a/src/astV6Dump.ml
+++ b/src/astV6Dump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:11) by Erwan Jahier> *)
open Lxm
@@ -355,10 +355,10 @@ and dump_val_exp (os: Format.formatter) (x: val_exp) = (
| CallByPos ( {it=oper; src=lxm} , pars ) -> dump_by_pos_exp os oper pars
| CallByName ({it=oper; src=lxm},nm_pars) -> dump_by_name_exp os oper nm_pars
| Merge_n (id, _) -> (* finish me *)
- fprintf os "merge %s (...) " (Ident.to_string id.it)
- | Merge_bool_n(id, t, f) ->
- fprintf os "merge %s (true -> %a) (false -> %a)"
- (Ident.to_string id.it) dump_val_exp t dump_val_exp f
+ fprintf os "merge %a (...) " dump_val_exp id.it
+ | Merge_bool_n({it=id}, t, f) ->
+ fprintf os "merge %a (true -> %a) (false -> %a)"
+ dump_val_exp id dump_val_exp t dump_val_exp f
)
and dump_val_exp_list (os : formatter) (xl: val_exp list) = (
match xl with
diff --git a/src/evalClock.ml b/src/evalClock.ml
index 7f3f691b6659198f03031881691eaee590b31bfd..a81d08bd1e24fd1e7a97d8ce4c819803c0923c19 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 16:05) by Erwan Jahier> *)
open AstPredef
@@ -212,8 +212,10 @@ and f_aux id_solver s ve =
raise (Compile_error(lxm, "\n*** can't eval constant: "^msg))
)
| Merge(ce, cl) ->
- let ce_id, (merge_clk : Lic.clock) =
- var_info_eff_to_clock_eff (IdSolver.var_info_of_ident id_solver ce.it ce.src)
+ let (merge_clk : Lic.clock) = List.hd ce.ve_clk in
+ let ce_id,lxm = match ce with
+ | { ve_core= CallByPosLic({it = VAR_REF id ; src = lxm },[]) } -> id,lxm
+ | _ -> assert false
in
let check_case s (c,ve) =
(* Check that ve is on c(ce) on merge_clk *)
@@ -224,13 +226,13 @@ and f_aux id_solver s ve =
| Enum_const_eff (s,_) -> s
| _ -> assert false
in
- let id_clk = (id_clk, ce.it, Lic.type_of_const c.it) in
+ let id_clk = (id_clk, ce_id, Lic.type_of_const c.it) in
let exp_clk = [On(id_clk, merge_clk)] in
let _ve,cel,s = f c.src id_solver s ve exp_clk in
s
in
let s = List.fold_left check_case s cl in
- ([ce.it,merge_clk],s), ce.src
+ ([ce_id,merge_clk],s), lxm
in
let new_clk = snd (List.split cel) in
let s, ve =
diff --git a/src/evalType.ml b/src/evalType.ml
index 48581c0309b163582c14e5c2f607ed545e2fcab5..bf7a7cd425f7ebd7b0cf067114ba905d0ae74880 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 03/04/2013 (at 15:41) by Erwan Jahier> *)
+(** Time-stamp: <modified the 04/04/2013 (at 16:05) by Erwan Jahier> *)
open AstPredef
@@ -51,8 +51,11 @@ let rec (f : IdSolver.t -> Lic.val_exp -> Lic.val_exp * Lic.type_ list) =
in
CallByNameLic ({it=nmop; src=lxm}, nmargs ), tl
)
- | Merge ({it=clk ; src=lxm}, nmargs ) -> (
- try eval_merge id_solver clk lxm nmargs
+ | Merge (mclk, nmargs ) -> (
+ let lxm = match mclk with {ve_core=CallByPosLic({src=lxm},[])} -> lxm
+ | _ -> assert false
+ in
+ try eval_merge id_solver mclk lxm nmargs
with EvalConst_error msg ->
raise (Compile_error(lxm, "\n*** can't eval constant: "^msg))
)
@@ -365,18 +368,19 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
(namargs, [struct_type])
| _ -> raise (Compile_error(lxm, "type error: a structure is expected"))
-and (eval_merge : IdSolver.t -> Ident.t -> Lxm.t ->
+and (eval_merge : IdSolver.t -> Lic.val_exp -> Lxm.t ->
(Lic.const Lxm.srcflagged * Lic.val_exp) list -> Lic.val_exp_core * Lic.type_ list) =
- fun id_solver clk lxm nargs ->
- let tclk = (IdSolver.var_info_of_ident id_solver clk lxm).var_type_eff in
+ fun id_solver mclk lxm nargs ->
+ let id_clk = match mclk with
+ | {ve_core=CallByPosLic({it=VAR_REF id},[])} -> id
+ | _ -> assert false
+ in
+ let tclk = (IdSolver.var_info_of_ident id_solver id_clk lxm).var_type_eff in
let nargs,tl_opt =
List.fold_left
(fun (acc,tl_opt) (c,ve) ->
(* check that id is of type tclk *)
- let id_type =
- (* let c = id_solver.id2const (Ident.idref_of_long id.it) id.src in *)
- type_of_const c.it
- in
+ let id_type = type_of_const c.it in
if id_type <> tclk then (
let msg = "type error in a merge branch: " ^
(Lic.string_of_type tclk) ^ " was expected, but " ^
@@ -401,6 +405,6 @@ and (eval_merge : IdSolver.t -> Ident.t -> Lxm.t ->
([],None)
nargs
in
- let tl = match tl_opt with Some tl -> tl | None -> assert false in
- Merge({it=clk; src=lxm}, nargs), tl
+ let tl = match tl_opt with Some tl -> tl | None -> assert false in
+ Merge(mclk, nargs), tl
diff --git a/src/l2lCheckLoops.ml b/src/l2lCheckLoops.ml
index d22337a04bb8b5bd101ee8d8cf52310995261aa3..f820c6483ea7ac96bc142f87b47fdb128388721d 100644
--- a/src/l2lCheckLoops.ml
+++ b/src/l2lCheckLoops.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 25/03/2013 (at 18:05) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:14) by Erwan Jahier> *)
open Lxm
open Errors
@@ -25,7 +25,7 @@ and
let s = vars_of_by_pos_op s by_pos_op.it in
List.fold_left vars_of_exp s vel
| Merge(ce, l) ->
- let s = IdSet.add ce.it s in
+ let s = vars_of_exp s ce in
List.fold_left (fun s (_,ve) -> vars_of_exp s ve) s l
| CallByNameLic(_, _) -> s
and
diff --git a/src/lic.ml b/src/lic.ml
index eb4f6c6b339666322e09eabd3020365a7490cc28..f19acc955c2ce053d5f8b28a125dd9d5b74394ac 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 16:06) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -159,11 +159,8 @@ and val_exp =
*)
and val_exp_core =
| CallByPosLic of (by_pos_op srcflagged * val_exp list)
- | CallByNameLic of
- (by_name_op srcflagged * (Ident.t srcflagged * val_exp) list)
- | Merge of Ident.t srcflagged * (const srcflagged * val_exp) list
-
-
+ | CallByNameLic of (by_name_op srcflagged * (Ident.t srcflagged * val_exp) list)
+ | Merge of val_exp * (const srcflagged * val_exp) list
and by_name_op =
| STRUCT of Ident.long
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index f7c0dc216c626b1df3e2ee3947989c25757ec9a1..fadee6ba5fb092b17b7c2a837829ee666c4eddfb 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 03/04/2013 (at 14:20) by Erwan Jahier> *)
+(** Time-stamp: <modified the 04/04/2013 (at 17:00) by Erwan Jahier> *)
open Lxm
open Lic
@@ -10,6 +10,7 @@ type action = ActionsDeps.action
(* Raised when a soc that haven't been translated yet is used in
another soc during the translation *)
exception Undef_soc of Soc.key * Lxm.t * Lic.by_pos_op * Soc.var_type list
+exception Undef_merge_soc of Soc.key * Lxm.t * val_exp * (const srcflagged * val_exp) list
(*********************************************************************************)
(** Informations liées au contexte de traduction. *)
@@ -277,10 +278,7 @@ let (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
let type_ = val_exp.Lic.ve_typ in
match v with
| CallByNameLic(by_name_op_flg,fl) -> assert false (* should not occur *)
- | Merge(c_flg, cl) ->
- print_string "Merge not yet supported, sorry\n";
- flush stdout;
- assert false
+ | Merge(c_flg, cl) -> assert false (* should not occur *)
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
| VAR_REF name ->
@@ -470,10 +468,6 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
ctx, actions@al, iol, ml, deps
)
- | Merge(c_flg, cl) ->
- print_string "Merge not yet supported, sorry\n";
- flush stdout;
- assert false
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
| Lic.ARRAY_SLICE _ | Lic.VAR_REF _ | Lic.CONST_REF _ | Lic.CONST _
@@ -501,8 +495,8 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
| CALL _ | PREDEF_CALL _
| HAT _ | ARRAY | PRE | ARROW | FBY | CONCAT -> (
(* retreive the soc of "expr" in soc_tbl *)
+ let id = by_pos_op_to_soc_ident by_pos_op_flg.it in
let soc : Soc.t =
- let id = by_pos_op_to_soc_ident by_pos_op_flg.it in
let args_types : Soc.var_type list =
List.map lic_to_soc_type
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
@@ -523,31 +517,78 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
);
raise (Undef_soc (sk, lxm, by_pos_op_flg.it, args_types))
in
- (* Use that soc to build the corresponding
- - actions
- - instances
- - action dependances
- *)
- let inputs = List.map (val_exp_to_filter ctx.prg) val_exp_list in
- let ctx, mem_opt = make_instance lxm clk ctx soc in
- let actions =
- let m2act = action_of_step lxm soc clk inputs lpl mem_opt in
- List.map m2act soc.Soc.step
- in
- let dependances : ActionsDeps.t =
- let (prefixed_actions : (Soc.ident * action) list) = List.map2
- (fun s a -> s.Soc.name,a) soc.Soc.step actions
- in
- ActionsDeps.generate_deps_from_step_policy
- soc.Soc.precedences prefixed_actions
- in
- let ml = match mem_opt with Some m -> m::ml | None -> ml in
- (ctx, actions, lpl, ml, dependances)
+ make_e2a_elt lxm clk lpl acc val_exp_list soc
)
)
+ | Merge(mclk, cl) -> (
+ let soc : Soc.t =
+ let (args_types : Soc.var_type list) =
+ List.map lic_to_soc_type
+ (List.flatten (List.map (fun (_,ve) -> ve.ve_typ) cl))
+ in
+ let res_type = get_exp_type lpl in
+ let full_profile = args_types @ res_type in
+ let sk = make_soc_key_of_node_exp (("Lustre","merge"),[]) full_profile in
+ try Soc.SocMap.find sk soc_tbl
+ with Not_found ->
+ Verbose.exe ~flag:dbg (fun () ->
+ let kl = fst (List.split (Soc.SocMap.bindings soc_tbl)) in
+ let klstr = List.map SocUtils.string_of_soc_key kl in
+ print_string ("\n********* Cannot find the soc.key " ^ (
+ SocUtils.string_of_soc_key sk) ^ " in \n\t" ^ (
+ String.concat "\n\t" klstr)^"\n"); flush stdout;
+ );
+ raise (Undef_merge_soc (sk, lxm, mclk, cl))
+ in
+ (* In order to reuse make_e2a_elt, I tranforsm the merge into a call
+ by position opeator ; hence I sort cl using to the type of mclk *)
+ let clk_type = List.hd mclk.ve_typ in
+ let (rank_of : Ident.long -> Ident.long -> Ident.long list -> int * int) =
+ fun c1 c2 l ->
+ let rec aux = function
+ | [] -> assert false
+ | x::t -> if x = c1 then 0,1 else if x = c2 then 1,0 else aux t
+ in
+ aux l
+ in
+ let long_of_const = function Enum_const_eff(l,_) -> l | _ -> assert false in
+ let compare_enum_case ({it=c1},_) ({it=c2},_) =
+ match clk_type with
+ | Bool_type_eff -> compare c2 c1 (* because in ocaml false < true *)
+ | Enum_type_eff(_,l) ->
+ let r1, r2 = rank_of (long_of_const c1) (long_of_const c2) l in
+ compare r1 r2
+ | _ -> assert false
+ in
+ let cl = List.sort compare_enum_case cl in
+ let val_exp_list = mclk::(List.map snd cl) in
+ make_e2a_elt lxm clk lpl acc val_exp_list soc
+ )
)
-
-
+and (make_e2a_elt: Lxm.t -> Lic.clock -> Soc.var_expr list -> e2a_acc ->
+ Lic.val_exp list -> Soc.t -> e2a_acc) =
+ (* Use the soc to build the corresponding
+ - actions
+ - instances
+ - action dependances
+ *)
+ fun lxm clk lpl (ctx, al, iol, ml, deps) val_exp_list soc ->
+ let inputs = List.map (val_exp_to_filter ctx.prg) val_exp_list in
+ let ctx, mem_opt = make_instance lxm clk ctx soc in
+ let actions =
+ let m2act = action_of_step lxm soc clk inputs lpl mem_opt in
+ List.map m2act soc.Soc.step
+ in
+ let dependances : ActionsDeps.t =
+ let (prefixed_actions : (Soc.ident * action) list) = List.map2
+ (fun s a -> s.Soc.name,a) soc.Soc.step actions
+ in
+ ActionsDeps.generate_deps_from_step_policy
+ soc.Soc.precedences prefixed_actions
+ in
+ let ml = match mem_opt with Some m -> m::ml | None -> ml in
+ (ctx, actions, lpl, ml, dependances)
+
(** Traduction d'une liste d'expressions. *)
and (actions_of_expression_list: Lxm.t -> Soc.tbl -> Lic.clock -> Soc.var_expr list ->
e2a_acc -> Lic.val_exp list -> e2a_acc) =
@@ -624,7 +665,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let soc_tbl = snd (process_node nk2 soc_tbl) in
snd (process_node nk soc_tbl)
- | Undef_soc (sk,lxm,pos_op, types) ->
+ | Undef_soc (sk,lxm,pos_op, types) -> (
let soc = SocPredef.soc_interface_of_pos_op lxm pos_op types in
if sk<>soc.key then (
print_string ("Soc key mismatch :\n\t" ^
@@ -648,6 +689,12 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
soc_tbl
in
snd (process_node nk soc_tbl)
+ )
+ | Undef_merge_soc (sk, lxm, clk, case_l) -> (
+ let soc = SocPredef.make_merge_soc sk in
+ let soc_tbl = SocMap.add soc.key soc soc_tbl in
+ snd (process_node nk soc_tbl)
+ )
in
sk, soc_tbl
(** Produit des soc de noeuds. *)
diff --git a/src/licDump.ml b/src/licDump.ml
index bf0573bcc05266ca98ac54f01384bf4e2a5fd5fe..7dac4aca08b05a496622b2f5232549468a5f79cc 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:17) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 11:31) by Erwan Jahier> *)
open Errors
open Printf
@@ -464,15 +464,15 @@ and string_of_val_exp_eff_core ve_core =
| Merge (ve, [({it=Bool_const_eff true }, ct); ({it=Bool_const_eff false}, cf)])
| Merge (ve, [({it=Bool_const_eff false}, cf); ({it=Bool_const_eff true}, ct)]) ->
if !Global.lv4 then (
- "if " ^ (Ident.to_string ve.it) ^ " then current (" ^
+ "if " ^ (string_of_val_exp_eff ve) ^ " then current (" ^
(string_of_val_exp_eff ct) ^ ") else current (" ^
(string_of_val_exp_eff cf) ^")"
) else (
- "merge " ^ (Ident.to_string ve.it) ^ " (true -> " ^
+ "merge " ^ (string_of_val_exp_eff ve) ^ " (true -> " ^
(string_of_val_exp_eff ct) ^ ") (false -> "^ (string_of_val_exp_eff cf) ^")"
)
| Merge (ve, cl) -> (
- "merge " ^ (Ident.to_string ve.it) ^ " " ^
+ "merge " ^ (string_of_val_exp_eff ve) ^ " " ^
(String.concat " "
(List.map
(fun (id,ve) -> "( "^(string_of_const_eff id.it) ^ " -> " ^
diff --git a/src/parserUtils.ml b/src/parserUtils.ml
index a6f5258e5ebd91c2caffd3076264fae4a80e3a00..1874a0cf67b4d1ce52224163d801f0fe07b21d42 100644
--- a/src/parserUtils.ml
+++ b/src/parserUtils.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:12) by Erwan Jahier> *)
(** *)
@@ -116,21 +116,44 @@ let flat_twice_flagged_list
List.fold_left g [] inlist
)
+
+(**********************************************************************************)
+(* Interface avec AstV6 *)
+
+(* we store ident names in a table to be able to generated fresh var
+ name that won't clash afterwards *)
+let (name_table : (string, unit) Hashtbl.t) =
+ Hashtbl.create 0
+
+let idref_of_lxm lxm =
+ let name = (Lxm.str lxm) in
+ if name.[0] = '_' then (
+ Hashtbl.add name_table name ());
+ try Lxm.flagit (Ident.idref_of_string name) lxm
+ with _ ->
+ print_string ("Parser.idref_of_lxm" ^(Lxm.str lxm));
+ assert false
+
(**********************************************************************************)
(** Traitement des listes d'idents avec valeur éventuelle
(constantes, champs de struct etc...)
*)
-
let (lexeme_to_ident_flagged: Lxm.t -> Ident.t Lxm.srcflagged) =
fun x -> {it = (Lxm.id x); src = x }
+let (lexeme_to_val_exp_flagged: Lxm.t -> val_exp Lxm.srcflagged) =
+ fun x ->
+ let idref = idref_of_lxm x in
+ let ve = CallByPos({ it = IDENT_n idref.it ; src=x },Oper []) in
+ {it = ve; src = x }
+
let (lexeme_to_pack_name_flagged:Lxm.t -> Ident.pack_name Lxm.srcflagged) =
fun x -> {it = (Ident.pack_name_of_string (Lxm.str x)); src = x }
let (make_merge_bool_op : Lxm.t -> val_exp -> val_exp -> val_exp) =
fun enum_clk vet vef ->
- Merge_bool_n(lexeme_to_ident_flagged enum_clk, vet, vef)
+ Merge_bool_n(lexeme_to_val_exp_flagged enum_clk, vet, vef)
type bool_or_idref = Bool of bool | Idref of Ident.idref
(** Utilitaries to build [val_exp] *)
@@ -151,11 +174,11 @@ let make_merge_op (enum_clk:Lxm.t) (l:(bool_or_idref * Lxm.t * val_exp) list) =
)
l
in
- Merge_n(lexeme_to_ident_flagged enum_clk, l)
+ Merge_n(lexeme_to_val_exp_flagged enum_clk, l)
let save_make_merge_op (enum_clk:Lxm.t) (l:(Ident.idref srcflagged * val_exp) list) =
let l = List.map (fun (idref,ve) -> idref,ve) l in
- Merge_n(lexeme_to_ident_flagged enum_clk, l)
+ Merge_n(lexeme_to_val_exp_flagged enum_clk, l)
@@ -203,23 +226,6 @@ let bynameexp lxm op nelst = CallByName( {src = lxm ; it = op } , nelst )
open Ident
-(**********************************************************************************)
-(* Interface avec AstV6 *)
-
-(* we store ident names in a table to be able to generated fresh var
- name that won't clash afterwards *)
-let (name_table : (string, unit) Hashtbl.t) =
- Hashtbl.create 0
-
-let idref_of_lxm lxm =
- let name = (Lxm.str lxm) in
- if name.[0] = '_' then (
- Hashtbl.add name_table name ());
- try Lxm.flagit (Ident.idref_of_string name) lxm
- with _ ->
- print_string ("Parser.idref_of_lxm" ^(Lxm.str lxm));
- assert false
-
(**********************************************************************************)
(** add_info
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index 698a448c9746dae876ce601e88964289017cf241..635055568c0dcc34bac2a15ff39c285d0232ace3 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 08:46) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 15:48) by Erwan Jahier> *)
open SocExecValue
open Soc
@@ -201,22 +201,37 @@ let lustre_if ctx =
in
{ ctx with s = sadd ctx.s vn vv }
+
+let make_names str start stop =
+ let res = ref [] in
+ for k=stop downto start do
+ res:= (str^(string_of_int k)) :: !res;
+ done;
+ !res
+
+
let lustre_array tl ctx =
let t,size = match List.hd (List.rev tl) with
| Soc.Array(t,i) -> t,i
| _ -> assert false
in
- let inames =
- let res = ref [] in
- for k=size downto 1 do
- res:= ("x"^(string_of_int k)) :: !res;
- done;
- !res
- in
+ let inames = make_names "x" 1 size in
let l = List.map (fun name -> get_val name ctx) inames in
let a = Array.of_list l in
{ ctx with s = sadd ctx.s ("z"::ctx.cpath) (A a) }
+let lustre_merge tl ctx =
+ let n = List.length tl in
+ let vnames = "clk"::(make_names "x" 0 (n-2)) in
+ let l = List.map (fun name -> get_val name ctx) vnames in
+ let (vn,vv) = match l with
+ | [B(true); v ; _]
+ | [B(false); _; v] -> "z"::ctx.cpath, v
+ | (E(_,i))::args -> "z"::ctx.cpath, List.nth args i
+ | _ -> assert false
+ in
+ { ctx with s = sadd ctx.s vn vv }
+
let lustre_concat ctx =
let (vn,vv) =
match ([get_val "x" ctx; get_val "y" ctx]) with
@@ -282,6 +297,7 @@ let (get: Soc.key -> (ctx -> ctx)) =
| "Lustre::concat" -> lustre_concat
| "Lustre::current" -> lustre_current
+ | "Lustre::merge" -> lustre_merge tl
| "Lustre::nor" -> assert false (* ougth to be translated into boolred *)
| "Lustre::diese" -> assert false (* ditto *)
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 51ecf8b4aa1fb40aa2985c572a0670b6618870ca..0acf7e698e0cb8be4fa56bedb1f9541decaa2c8c 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 15:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/04/2013 (at 16:01) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -283,7 +283,7 @@ let of_soc_key : Soc.key -> Soc.t =
Soc.step = [
{
name = "step";
- lxm = Lxm.dummy "nor soc";
+ lxm = Lxm.dummy "diese soc";
idx_ins = [0];
idx_outs = [0];
impl = Boolred(1,1, size);
@@ -379,6 +379,31 @@ let make_slice_soc: Lic.slice_info -> Soc.var_type -> Soc.t =
}
+let (make_merge_soc: Soc.key -> Soc.t) =
+ fun sk ->
+ let (id, tl, _) = sk in
+ let in_tl, out_t = match List.rev tl with x::l -> List.rev l, x | [] -> assert false in
+ let profile_in = ("clk", List.hd in_tl)::
+ (List.mapi (fun i vt -> "x"^(string_of_int i), vt) in_tl)
+ in
+ let i = List.length in_tl in
+ {
+ Soc.key = sk;
+ Soc.profile = profile_in, ["z", out_t];
+ Soc.instances = [] ;
+ Soc.step = [
+ {
+ name = "step";
+ lxm = Lxm.dummy "merge soc";
+ idx_ins = SocUtils.gen_index_list (i+1);
+ idx_outs = [0];
+ impl = Predef;
+ }
+ ];
+ Soc.have_mem = None;
+ Soc.precedences = [];
+ }
+
let make_array_soc: int -> Soc.var_type -> Soc.t =
fun i t ->
let iprof =
diff --git a/src/socPredef.mli b/src/socPredef.mli
index 398211cc46a2a8023825143aa988efd85c641304..1bbd9e949563b4947d97b7087c29573c81ee2742 100644
--- a/src/socPredef.mli
+++ b/src/socPredef.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 29/03/2013 (at 16:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/04/2013 (at 17:54) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -15,3 +15,4 @@ val soc_interface_of_pos_op:
val get_mem_name : Soc.key -> Soc.var_type -> string
+val make_merge_soc: Soc.key -> Soc.t
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 95b1048f37b26918f8b13602aee871b76b548b5d..f39d5dcd61ba2fc6796ecb6370dd833e1fd99e06 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Wed Apr 3 15:41:46 2013
+Test Run By jahier on Thu Apr 4 16:04:24 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 4095f9657b478d13263a9dfb503871544e9fb661..76997001418c69fdba5c738b15d75c03a8b0ec06 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 25 seconds
-testcase ./lus2lic.tests/progression.exp completed in 1 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 24 seconds
+testcase ./lus2lic.tests/progression.exp completed in 0 seconds
diff --git a/test/should_work/merge.lus b/test/should_work/merge.lus
index 1bfb2bbe1e8389c7208ff3a5bd7a4b4398d40e7b..64a1c6b4c8214c7f1d583b424d97f50a1cf3a5b2 100644
--- a/test/should_work/merge.lus
+++ b/test/should_work/merge.lus
@@ -6,7 +6,7 @@ node merge_node(clk: trival; ---
returns (y: int); ---
let
y = merge clk
- ( Pile -> 0->i1)
+ ( Pile -> i1)
( Face -> i2)
( Tranche -> i3);
tel