diff --git a/lib/actionsDeps.ml b/lib/actionsDeps.ml
index 6d785584299b43863224e2ba7f3a904d8ef3d9f3..be8842b3a0a2c2aaca137a5991f9e586bd7b83d1 100644
--- a/lib/actionsDeps.ml
+++ b/lib/actionsDeps.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 06/03/2020 (at 13:32) by Erwan Jahier> *)
+(** Time-stamp: <modified the 21/03/2022 (at 11:43) by Erwan Jahier> *)
let dbg = (Lv6Verbose.get_flag "deps")
@@ -30,13 +30,20 @@ let (have_deps : t -> action -> bool) =
(* exported *)
let (remove_dep : t -> action -> t) =
fun deps a ->
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf " remove_deps(%s)\n%!" (Action.to_string a));
MapAction.remove a deps
(* exported *)
let (find_deps: t -> action -> action list) =
fun m a ->
+ let res =
try Actions.elements (MapAction.find a m) with Not_found -> []
-
+ in
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf "find_deps(%s)='%s'\n%!" (Action.to_string a)
+ (String.concat "+" (List.map Action.to_string res)));
+ res
let rec (depends_on : t -> Action.t -> Action.t -> bool) =
fun m a1 a2 ->
@@ -52,12 +59,20 @@ let rec (depends_on : t -> Action.t -> Action.t -> bool) =
(** Ajoute une liste de dépendances à une action. *)
let add_deps: t -> action -> action list -> t =
fun m a -> function
- | [] -> m
- | al ->
- let actions = try MapAction.find a m with Not_found -> Actions.empty in
- let actions = List.fold_left (fun set a -> Actions.add a set) actions al in
- MapAction.add a actions m
-
+ | [] ->
+ Lv6Verbose.exe
+ ~flag:dbg (fun () -> Printf.printf " add_deps(%s,[]) \n%!" (Action.to_string a));
+ m
+ | al ->
+ Lv6Verbose.exe
+ ~flag:dbg (fun () -> Printf.printf "\n add_deps(%s,???)\n%!" (Action.to_string a));
+ let actions = try MapAction.find a m with Not_found -> Actions.empty in
+ let actions = List.fold_left (fun set a -> Actions.add a set) actions al in
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf " add_deps(%s,[%s])\n%!" (Action.to_string a)
+ (String.concat "+" (List.map Action.to_string al)));
+ MapAction.add a actions m
+
(* exported *)
let (concat: t -> t -> t) =
fun m1 m2 ->
@@ -82,11 +97,7 @@ let (generate_deps_from_step_policy:
(*********************************************************************************)
-module OrderedSocVar = struct
- type t = Soc.var_expr
- let compare = compare
-end
-module VarMap = Map.Make(OrderedSocVar)
+module VarMap = Map.Make(String)
(** A Data structure that maps a Soc.var_expr to all the
actions that needed to compute it.
@@ -102,8 +113,11 @@ when defining arrays or structures parts by parts. For instance
*)
type var2actions_tbl = Actions.t VarMap.t
-let var2actions k tbl = try VarMap.find k tbl with Not_found -> Actions.empty
-
+let var2actions k tbl =
+ let k = SocUtils.string_of_filter k in
+ let res = try VarMap.find k tbl with Not_found -> Actions.empty in
+ res
+
let rec (gen_parents : Soc.var_expr -> Soc.var_expr list) =
fun var ->
(* if var = t.[2].field, then it returns [t.[2].field; t.[2] ; t] *)
@@ -162,11 +176,11 @@ let nodupl l =
let (get_var2actions_tbl : action list -> var2actions_tbl) =
fun al ->
- let (tabulate_action : var2actions_tbl -> action -> var2actions_tbl) =
- fun tbl action ->
- let _, _, lhs, _, _lxm = action in
- let (tabulate_output:var2actions_tbl -> Soc.var_expr -> var2actions_tbl) =
- fun tbl output ->
+ let (tabulate_action : var2actions_tbl -> action -> var2actions_tbl) =
+ fun tbl action ->
+ let _, _, lhs, _, _lxm = action in
+ let (tabulate_output:var2actions_tbl -> Soc.var_expr -> var2actions_tbl) =
+ fun tbl output ->
let v = (* get_top_var *) output in (* for x of type t^2^2 *)
let children = gen_children v in (* children(x[0]) = [x[0][0];x[0][1]] *)
let parents = gen_parents v in (* and parents(x[0]) = [x] *)
@@ -175,15 +189,18 @@ let (get_var2actions_tbl : action list -> var2actions_tbl) =
(* add the current action as a dep of v and its children and its parents *)
List.fold_left
(fun tbl cv ->
- let cv_actions = var2actions cv tbl in
- VarMap.add cv (Actions.add action cv_actions) tbl)
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf " var_add_deps: '%s' depends on '%s'\n%!"
+ (SocUtils.string_of_var_expr cv) (Action.to_string action));
+ let cv_actions = var2actions cv tbl in
+ VarMap.add (SocUtils.string_of_filter cv) (Actions.add action cv_actions) tbl)
tbl all
in
tbl
- in
- List.fold_left tabulate_output tbl lhs
- in
- List.fold_left tabulate_action VarMap.empty al
+ in
+ List.fold_left tabulate_output tbl lhs
+ in
+ List.fold_left tabulate_action VarMap.empty al
(** Returns the actions that depend on a set of vars, according to the content
@@ -213,14 +230,21 @@ let (actions_of_vars: Soc.var_expr list -> var2actions_tbl -> action list) =
Actions.empty
vars
in
- Actions.elements actions
+ let res = Actions.elements actions in
+ Lv6Verbose.exe
+ ~flag:dbg (fun () ->
+ Printf.printf "actions_of_vars(%s)='%s'\n%!"
+ (String.concat "," (List.map SocUtils.string_of_var_expr vars))
+ (String.concat "+" (List.map Action.to_string res))
+ );
+ res
(*********************************************************************************)
(* Some Printers to ease the debugging *)
let string_of_actions: Actions.t -> string = fun s ->
let to_string a acc =
- acc ^ "\n\t + '"^ (Action.to_string a) ^ "'"
+ acc ^ "\n\t + '"^ (Action.to_string_msg a) ^ "'"
in
"" ^ (Actions.fold to_string s "") ^ ""
@@ -228,8 +252,7 @@ let string_of_var2actions_tbl: var2actions_tbl -> string =
fun s ->
let to_string key value acc =
let entry = Format.sprintf "%s depends on the following actions: %s"
- (SocUtils.string_of_filter key)
- (string_of_actions value)
+ key (string_of_actions value)
in
acc ^ entry ^ "\n"
in
@@ -285,10 +308,11 @@ let build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list ->
(* let tbl = add_parents tbl in *)
let pp_dbg () =
let al_str = List.map Action.to_string al in
- print_string "\n ====> List of actions to be sorted:\n";
- print_string (String.concat "\n " al_str);
- print_string "\n ====> List of computed dependencies:\n";
+ print_string "\n ====> List of actions to be sorted:\n - ";
+ print_string (String.concat "\n - " al_str);
+ print_string "\n ====> List of previously computed dependencies:(\n ";
print_string (string_of_var2actions_tbl tbl);
+ print_string ")\n";
flush stdout
in
let deps =
@@ -300,18 +324,23 @@ let build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list ->
| Lic.BaseLic -> rhs
| Lic.ClockVar _int -> rhs
| Lic.On ((_cc,cv,ct),_) ->
- (* The guard should be computed before the guarded expression *)
- (Soc.Var(cv, lic_to_data_type ct))::rhs
+ (* The clock should be computed before the clocked expression *)
+ (Soc.Var(cv, lic_to_data_type ct))::rhs
in
- let deps = actions_of_vars dep_vars tbl in
- if deps = [] then (
- let rhs_str = String.concat "," (List.map SocUtils.string_of_filter rhs) in
+ let action_deps = actions_of_vars dep_vars tbl in
+ if action_deps = [] then (
+ let dep_str = String.concat "," (List.map SocUtils.string_of_filter dep_vars) in
Lv6Verbose.exe
- ~flag:dbg (fun () -> print_string ("\n====> No deps for " ^ rhs_str));
+ ~flag:dbg (fun () ->
+ Printf.printf " No deps for %s (dep_vars=%s) \n%!" (Action.to_string action) dep_str);
acc_deps
)
- else
- add_deps acc_deps action deps
+ else (
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf " %s depends on %s ==> calling add_deps\n" (Action.to_string action)
+ (String.concat " + " (List.map Action.to_string action_deps)));
+ add_deps acc_deps action action_deps
+ )
)
deps
al
diff --git a/lib/actionsDeps.mli b/lib/actionsDeps.mli
index 8c819a3deeb7c4ea2b8ce19a3c06237ae9864352..2ef0d92042ab2d284803539af348dd48c1d70843 100644
--- a/lib/actionsDeps.mli
+++ b/lib/actionsDeps.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 11/07/2017 (at 14:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/03/2022 (at 22:19) by Erwan Jahier> *)
(** Compute dependencies between actions *)
@@ -10,14 +10,14 @@ val empty : t
(** Linear in the size of the first parameter *)
val concat: t -> t -> t
+(** Compute the action dependencies that comes from the equations
+ I/O.
-(** Compute the action dependencies that comes from the equations I/O.
-
- Construit des dépendances entre les actions en reliant les entrées et
- les sorties de ces actions.
+ Ajoute à une liste de dépendances existante celles issues d'une
+ liste d'actions (dont les entrées dépendent des sorties).
Lic2soc.lic_to_soc_type is passed in argument to break a dep loop
-*)
+ *)
val build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> Action.t list -> t
(** Use the dependency constraints that come from the SOC (e.g., 'get' before 'set'
diff --git a/lib/lic2soc.ml b/lib/lic2soc.ml
index 6221829667fc5a5ff1716c81238b4e0ebf9ebbb8..4ad28b1f0faf5685122c6a3f3a52608e2ca50706 100644
--- a/lib/lic2soc.ml
+++ b/lib/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2019 (at 16:43) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/03/2022 (at 22:43) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -511,7 +511,7 @@ let (make_instance :
(*********************************************************************************)
(** actions_of_expression_acc translates an expression and an
- accumulator into an new accumulator. The accumulator is augmented
+ accumulator into an new accumulator. The accumulator is updated
with the action resulting from the translation of the expression
plus the new dependancies.
@@ -520,197 +520,200 @@ let (make_instance :
(i.e., not by actions_of_expression)
*)
type e2a_acc =
- ctx * action list * Soc.var_expr list (* this list is used in rec calls*)
- * Soc.instance list * ActionsDeps.t
+ ctx
+ * action list (* collected when iterating on equations *)
+ * Soc.var_expr list (* an accumutor, but local for actions_of_expression_acc *)
+ * Soc.instance list (* collected when iterating on equations *)
+ * ActionsDeps.t (* Ditto *)
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
fun _lxm soc_tbl clk lpl acc expr ->
- let (ctx, al, iol, ml, deps) = acc in
- match get_leaf ctx.prg expr with
- | Some names ->
- (* expr est déjà une feuille (un ident ou une constante), RAF. *)
- let action = clk, names, lpl, Soc.Assign, expr.ve_src in
- (ctx, action::al, iol@names, ml, deps)
- | None -> (
- let v = expr.Lic.ve_core in
- match v with
- | CallByNameLic(_by_name_op_flg,fl) -> (
- (* Pas de soc pour les structures non plus. On se
- contente d'éclater la structure en autant d'égalités
- que nécessaire. *)
- let filter_to_field filter field ftype =
- let ftype = match ftype with [x] -> x | _ -> assert false in
- let filter = match filter with [x] -> x | _ -> assert false in
- Soc.Field(filter, field, lic_to_data_type ftype)
- in
- let actions =
- List.map
- (fun (fn, fv) ->
- let ft = fv.ve_typ in
- let nfv = val_exp_to_filter ctx.prg fv in
- (clk, nfv, [filter_to_field lpl fn.it ft], Soc.Assign, fn.src)
- )
- fl
- in
- ctx, List.rev_append actions al, iol, ml, deps
- )
- | Merge(mclk, cl) -> (
- (* Merge (like when) does not generate any soc, but states when
- expressions are executed.
+ let (ctx, al, iol, ml, deps) = acc in
+ match get_leaf ctx.prg expr with
+ | Some names ->
+ (* expr est déjà une feuille (un ident ou une constante), RAF. *)
+ let action = clk, names, lpl, Soc.Assign, expr.ve_src in
+ (ctx, action::al, iol@names, ml, deps)
+ | None -> (
+ let v = expr.Lic.ve_core in
+ match v with
+ | CallByNameLic(_by_name_op_flg,fl) -> (
+ (* Pas de soc pour les structures non plus. On se
+ contente d'éclater la structure en autant d'égalités
+ que nécessaire. *)
+ let filter_to_field filter field ftype =
+ let ftype = match ftype with [x] -> x | _ -> assert false in
+ let filter = match filter with [x] -> x | _ -> assert false in
+ Soc.Field(filter, field, lic_to_data_type ftype)
+ in
+ let actions =
+ List.map
+ (fun (fn, fv) ->
+ let ft = fv.ve_typ in
+ let nfv = val_exp_to_filter ctx.prg fv in
+ (clk, nfv, [filter_to_field lpl fn.it ft], Soc.Assign, fn.src)
+ )
+ fl
+ in
+ ctx, List.rev_append actions al, iol, ml, deps
+ )
+ | Merge(mclk, cl) -> (
+ (* Merge (like when) does not generate any soc, but states when
+ expressions are executed.
- Here, we split Lic.Merge into several actions. Hopefully,
- the test opening optimisation stage would be able to
- reconstruct this merge into a proper Soc.Case.
- *)
- let acc = List.fold_left
+ Here, we split Lic.Merge into several actions. Hopefully,
+ the test opening optimisation stage would be able to
+ reconstruct this merge into a proper Soc.Case.
+ *)
+ let clk_type = List.hd mclk.ve_typ in
+ let clkclk = List.hd mclk.ve_clk in
+ let clk_id = match mclk with
+ | { ve_core= CallByPosLic({it=VAR_REF id;_},[]) ;_} -> id
+ | _ -> assert false
+ in
+ let acc = List.fold_left
(fun acc (cc_flg,ve) ->
- let clk_type = List.hd mclk.ve_typ in
- let clkclk = List.hd mclk.ve_clk in
- let clk_id = match mclk with
- | { ve_core= CallByPosLic({it=VAR_REF id;_},[]) ;_} -> id
- | _ -> assert false
- in
- let cc_long = match cc_flg.it with
- | Bool_const_eff true -> "Lustre", "true"
- | Bool_const_eff false -> "Lustre", "false"
- | Enum_const_eff(long,_) -> long
- | _ -> assert false
- in
- let (clk:Lic.clock) = On((cc_long, clk_id, clk_type),clkclk) in
- let ctx, actions, _, mems, deps = acc in
- let ctx, actions2, inputs, mems2, deps2 =
- actions_of_expression cc_flg.src soc_tbl ctx clk lpl ve
- in
- let mems = mems@mems2 in
- let deps = ActionsDeps.concat deps deps2 in
- let actions = actions@actions2 in
- ctx, actions, inputs, mems, deps
+ let cc_long = match cc_flg.it with
+ | Bool_const_eff true -> "Lustre", "true"
+ | Bool_const_eff false -> "Lustre", "false"
+ | Enum_const_eff(long,_) -> long
+ | _ -> assert false
+ in
+ let (clk:Lic.clock) = On((cc_long, clk_id, clk_type),clkclk) in
+ let ctx, actions, _, mems, deps = acc in
+ let ctx, actions2, inputs, mems2, deps2 =
+ actions_of_expression cc_flg.src soc_tbl ctx clk lpl ve
+ in
+ let mems = mems@mems2 in
+ let deps = ActionsDeps.concat deps deps2 in
+ let actions = actions@actions2 in
+ ctx, actions, inputs, mems, deps
)
acc
cl
- in
- acc
- )
- | CallByPosLic (by_pos_op_flg, val_exp_list) -> (
- match by_pos_op_flg.it with
- | Lic.WHEN ck -> (
- (* 'when' does not generate any soc, but it states
- when expressions are executed . *)
- let ctx, actions, inputs, mems, deps =
- actions_of_expression_list by_pos_op_flg.src soc_tbl clk
- lpl acc val_exp_list
+ in
+ acc
+ )
+ | CallByPosLic (by_pos_op_flg, val_exp_list) -> (
+ match by_pos_op_flg.it with
+ | Lic.WHEN ck -> (
+ (* 'when' does not generate any soc, but it states
+ when expressions are executed . *)
+ let ctx, actions, inputs, mems, deps =
+ actions_of_expression_list by_pos_op_flg.src soc_tbl clk
+ lpl acc val_exp_list
+ in
+ let ctx, outputs, actions_reclocked =
+ match actions with
+ | [] -> (* val_exp is a leaf x. *)
+ let lxm = by_pos_op_flg.src in
+ ctx, lpl, [ck, inputs, lpl, Soc.Assign, lxm]
+ | _ -> ctx, inputs,
+ (* Remplacement de l'horloge des actions de l'expression par
+ la nouvelle horloge issue du `when`. *)
+ List.map (fun (_, i,o,op,lxm) -> ck,i,o,op,lxm) actions
+ in
+ ctx, actions_reclocked, outputs, mems, deps
+ )
+ | Lic.VAR_REF _ | Lic.CONST_REF _ | Lic.CONST _
+ | Lic.ARRAY_ACCES _ | Lic.STRUCT_ACCESS _ | Lic.TUPLE
+ -> assert false (* should not occur: handled via get_leaf *)
+ | CURRENT _
+ | Lic.ARRAY_SLICE _
+ | CALL _ | PREDEF_CALL _
+ | HAT _ | ARRAY | PRE | ARROW | FBY | CONCAT -> (
+ (* retreive the soc of "expr" in soc_tbl *)
+ let soc : Soc.t =
+ let args_types : Data.t list =
+ List.map lic_to_data_type
+ (List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in
- let ctx, outputs, actions_reclocked =
- match actions with
- | [] -> (* val_exp is a leaf x. *)
- let lxm = by_pos_op_flg.src in
- ctx, lpl, [ck, inputs, lpl, Soc.Assign, lxm]
- | _ -> ctx, inputs,
- (* Remplacement de l'horloge des actions de l'expression par
- la nouvelle horloge issue du `when`. *)
- List.map (fun (_, i,o,op,lxm) -> ck,i,o,op,lxm) actions
+ let res_type = List.map lic_to_data_type expr.ve_typ in
+ (* let (get_exp_type : Soc.var_expr list -> Data.t list) =
+ fun vl ->
+ let tl = List.map Soc.data_type_of_var_expr vl in
+ tl
+ let res_type = get_exp_type lpl in *)
+ let full_profile = args_types @ res_type in
+ let si_opt = match by_pos_op_flg.it with
+ Lic.ARRAY_SLICE si -> Some si | _ -> None
in
- ctx, actions_reclocked, outputs, mems, deps
- )
- | Lic.VAR_REF _ | Lic.CONST_REF _ | Lic.CONST _
- | Lic.ARRAY_ACCES _ | Lic.STRUCT_ACCESS _ | Lic.TUPLE
- -> assert false (* should not occur: handled via get_leaf *)
- | CURRENT _
- | Lic.ARRAY_SLICE _
- | CALL _ | PREDEF_CALL _
- | HAT _ | ARRAY | PRE | ARROW | FBY | CONCAT -> (
- (* retreive the soc of "expr" in soc_tbl *)
- let soc : Soc.t =
- let args_types : Data.t list =
- List.map lic_to_data_type
- (List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
- in
- let res_type = List.map lic_to_data_type expr.ve_typ in
- (* let (get_exp_type : Soc.var_expr list -> Data.t list) =
- fun vl ->
- let tl = List.map Soc.data_type_of_var_expr vl in
- tl
- let res_type = get_exp_type lpl in *)
- let full_profile = args_types @ res_type in
- let si_opt = match by_pos_op_flg.it with
- Lic.ARRAY_SLICE si -> Some si | _ -> None
- in
- (* XXX Béquille en attendant mieux *)
- let (node_key_of_pos_op : Lic.by_pos_op -> Lic.node_key) = fun op ->
- match op with
- | PRE -> ("","Lustre::pre"),[]
- | ARROW -> ("","Lustre::arrow" ),[]
- | FBY-> ("","Lustre::fby"),[]
- | CURRENT _ -> ("","Lustre::current"),[]
- | CONCAT-> ("","Lustre::concat"),[]
- | ARRAY -> ("","Lustre::array"),[]
- | ARRAY_SLICE _ -> ("","Lustre::array_slice"),[]
- | HAT _ -> ("","Lustre::hat"),[]
- | CALL n | PREDEF_CALL n -> n.it
- | _ -> assert false
- in
- let node_key = node_key_of_pos_op by_pos_op_flg.it in
- let sk = make_soc_key_of_node_key node_key si_opt full_profile in
- let (sk_name, sk_prof,_) = sk in
- let sk,fby_init_opt =
- match by_pos_op_flg.it with
- | Lic.FBY ->
- let init = val_exp_to_filter ctx.prg (List.hd val_exp_list) in
- let init = List.hd init in
- (sk_name, sk_prof, Soc.MemInit init), Some init
- | Lic.ARROW ->
- let init = Soc.Const("_true", Data.Bool) in
- (sk_name, sk_prof, Soc.MemInit init), Some init
- | Lic.CURRENT (Some cc) ->
- (sk_name, sk_prof, Soc.Curr(cc)), None
- | _ -> sk, None
- in
- try SocUtils.find by_pos_op_flg.src sk soc_tbl
- with Lv6errors.Compile_error(lxm,msg) ->
- Lv6Verbose.exe ~flag:dbg (fun () -> print_string msg; flush stdout);
- raise (Undef_soc (sk, lxm,by_pos_op_flg.it,args_types,fby_init_opt))
+ (* XXX Béquille en attendant mieux *)
+ let (node_key_of_pos_op : Lic.by_pos_op -> Lic.node_key) = fun op ->
+ match op with
+ | PRE -> ("","Lustre::pre"),[]
+ | ARROW -> ("","Lustre::arrow" ),[]
+ | FBY-> ("","Lustre::fby"),[]
+ | CURRENT _ -> ("","Lustre::current"),[]
+ | CONCAT-> ("","Lustre::concat"),[]
+ | ARRAY -> ("","Lustre::array"),[]
+ | ARRAY_SLICE _ -> ("","Lustre::array_slice"),[]
+ | HAT _ -> ("","Lustre::hat"),[]
+ | CALL n | PREDEF_CALL n -> n.it
+ | _ -> assert false
in
- make_e2a_elt by_pos_op_flg.src clk lpl acc val_exp_list soc
- )
- )
- )
+ let node_key = node_key_of_pos_op by_pos_op_flg.it in
+ let sk = make_soc_key_of_node_key node_key si_opt full_profile in
+ let (sk_name, sk_prof,_) = sk in
+ let sk,fby_init_opt =
+ match by_pos_op_flg.it with
+ | Lic.FBY ->
+ let init = val_exp_to_filter ctx.prg (List.hd val_exp_list) in
+ let init = List.hd init in
+ (sk_name, sk_prof, Soc.MemInit init), Some init
+ | Lic.ARROW ->
+ let init = Soc.Const("_true", Data.Bool) in
+ (sk_name, sk_prof, Soc.MemInit init), Some init
+ | Lic.CURRENT (Some cc) ->
+ (sk_name, sk_prof, Soc.Curr(cc)), None
+ | _ -> sk, None
+ in
+ try SocUtils.find by_pos_op_flg.src sk soc_tbl
+ with Lv6errors.Compile_error(lxm,msg) ->
+ Lv6Verbose.exe ~flag:dbg (fun () -> print_string msg; flush stdout);
+ raise (Undef_soc (sk, lxm,by_pos_op_flg.it,args_types,fby_init_opt))
+ in
+ make_e2a_elt by_pos_op_flg.src 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) =
fun lxm clk lpl acc val_exp_list soc ->
- (* Update the acc with the actions made of the soc call:
- « lpl = soc(val_exp_list) » on clk
- *)
- let (ctx, al, iol, ml, deps) = acc in
- let inputs = List.flatten (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 actions = al @ actions in
- let dependances : ActionsDeps.t =
- let (prefixed_actions : (Soc.ident * action) list) = List.map2
+ (* Update the acc with the actions made of the soc call:
+ « lpl = soc(val_exp_list) » on clk
+ *)
+ let (ctx, al, iol, ml, deps) = acc in
+ let inputs = List.flatten (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 actions = al @ actions 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 dependances = ActionsDeps.concat deps dependances in
- let ml = match mem_opt with Some m -> m::ml | None -> ml in
- (ctx, actions, iol, ml, dependances)
-
+ ActionsDeps.generate_deps_from_step_policy
+ soc.Soc.precedences prefixed_actions
+ in
+ let dependances = ActionsDeps.concat deps dependances in
+ let ml = match mem_opt with Some m -> m::ml | None -> ml in
+ (ctx, actions, iol, 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) =
fun lxm soc_tbl clk lpl expr_list acc ->
- List.fold_left (actions_of_expression_acc lxm soc_tbl clk lpl) expr_list acc
+ List.fold_left (actions_of_expression_acc lxm soc_tbl clk lpl) expr_list acc
and (actions_of_expression : Lxm.t -> Soc.tbl -> ctx -> Lic.clock -> Soc.var_expr list ->
Lic.val_exp -> e2a_acc) =
fun lxm soc_tbl ctx clk lpl expr ->
- let acc0 = (ctx, [], [], [], ActionsDeps.empty) in
- actions_of_expression_acc lxm soc_tbl clk lpl acc0 expr
+ let acc0 = (ctx, [], [], [], ActionsDeps.empty) in
+ actions_of_expression_acc lxm soc_tbl clk lpl acc0 expr
@@ -875,6 +878,8 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
(fun () -> print_string (ActionsDeps.to_string all_deps); flush stdout);
profile_info " SortActions.f: sorting actions...\n";
let gaol = SortActions.f actions all_deps lxm in
+
+
profile_info " Lic2soc.soc_of_node: actions sorted. \n";
let (locals: Soc.var list) =
match node.Lic.loclist_eff with
diff --git a/lib/soc2c.ml b/lib/soc2c.ml
index ba7470129df12273f6d9f70dd45d5163ff4f6a39..97f5828708bd4801b89308aaf6822c9c320da2a5 100644
--- a/lib/soc2c.ml
+++ b/lib/soc2c.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/09/2021 (at 13:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 21/03/2022 (at 11:36) by Erwan Jahier> *)
(* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
@@ -1020,6 +1020,7 @@ typedef float _float;
Lv6util.entete och "/*" "*/";
puth "\n#include <stdlib.h>\n";
+ puth "\n#include <string.h>\n";
if needs_hfile || args.Lv6MainArgs.ext_types then (
puth (Printf.sprintf "#ifndef _%s_H_FILE\n" base0);
puth (Printf.sprintf "#include \"%s\"\n" ext_hfile0);
diff --git a/lib/socUtils.ml b/lib/socUtils.ml
index 116a2668f39ea914027d4375902a87433fa85703..2e6b14829e18204cac5e76e80b3d5db40d54b964 100644
--- a/lib/socUtils.ml
+++ b/lib/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2019 (at 16:48) by Erwan Jahier> *)
+(** Time-stamp: <modified the 21/03/2022 (at 11:11) by Erwan Jahier> *)
open Soc
@@ -411,3 +411,13 @@ let rec (lustre_string_of_var_expr: Soc.var_expr -> string) =
| Index(f, index,_) -> Printf.sprintf "%s[%i]" (lustre_string_of_var_expr f) index
| Slice(_f,_fi,_la,_st,_wi,_vt) -> assert false (* should not occur *)
+let rec (string_of_var_expr: Soc.var_expr -> string) =
+ function
+ | Const("true", t) -> "true:" ^(Data.type_to_string t)
+ | Const("false", t) -> "false:"^(Data.type_to_string t)
+ | Const(id, t) -> id^":"^(Data.type_to_string t)
+ | Var (id,t) -> id^":"^(Data.type_to_string t)
+ | Field(f, id,_) -> Printf.sprintf "%s.%s" (string_of_var_expr f) (id2s id)
+ | Index(f, index,_) -> Printf.sprintf "%s[%i]" (string_of_var_expr f) index
+ | Slice(_f,_fi,_la,_st,_wi,_vt) -> assert false (* should not occur *)
+
diff --git a/lib/socUtils.mli b/lib/socUtils.mli
index c7d47f2e6c87b07bd386a9f067bfc00e39b9dd8a..90a3c59315bfb5e9ddc47d46fd0a1721a4b22f67 100644
--- a/lib/socUtils.mli
+++ b/lib/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/09/2017 (at 09:54) by Erwan Jahier> *)
+(** Time-stamp: <modified the 21/03/2022 (at 11:08) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -77,3 +77,4 @@ val get_rank : 'a -> ('a * 'b) list -> int
val get_top_var : Soc.var_expr -> Soc.var_expr
val lustre_string_of_var_expr: Soc.var_expr -> string
+val string_of_var_expr: Soc.var_expr -> string
diff --git a/lib/sortActions.ml b/lib/sortActions.ml
index 77f61225c05b429b4b4395aef351cf9f4a5db6b1..a6c19e64e0f82de4affd68c69033f53842b31822 100644
--- a/lib/sortActions.ml
+++ b/lib/sortActions.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2019 (at 16:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 21/03/2022 (at 10:14) by Erwan Jahier> *)
(** topological sort of actions (that may optimize test openning) *)
@@ -26,7 +26,7 @@ let (topo_sort : Action.t list -> ActionsDeps.t -> Action.t list) =
(*********************************************************************************)
(* From actions to gaos *)
-let (gao_of_action: Action.t -> Soc.gao) =
+let (gao_of_action: Action.t -> Soc.gao) =
fun (ck, il, ol, op, lxm) ->
(* nb : the list (encoded in a tree) is in the reverse order *)
let rec unpack_clock acc = function
@@ -88,8 +88,10 @@ let (f : Action.t list -> ActionsDeps.t -> Lxm.t -> Soc.gao list) =
let actions = topo_sort actions deps in
profile_info "SortActions.f: gao_of_action...\n";
let gaol = List.map gao_of_action actions in
+ (* Printf.printf "YYY ==> %s <==\n%!" (SocUtils.string_of_gaos_list gaol ); *)
profile_info "SortActions.f: optimize_test_openning actions...\n";
- optimize_test_openning gaol deps
+ let gaol = optimize_test_openning gaol deps in
+ gaol
)
| Sort -> ( (* experimental scheduling *)
let actions = List.sort SortActionsExpe.compare_actions actions in
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 223a8d865679bf478211d421fbba286f680ce7ac..742e4b0dad9d5aabb7b477c6f83aa151ee93c27b 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test run by jahier on Wed Sep 22 11:33:28
+Test run by jahier on Mon Mar 21 11:39:44
Native configuration is x86_64-pc-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 Wed Sep 22 11:33:30
+Test run by jahier on Mon Mar 21 11:39:45
Native configuration is x86_64-pc-linux-gnu
=== lus2lic1 tests ===
@@ -414,7 +414,7 @@ PASS: ./lus2lic {-2c multipar.lus -n multipar}
PASS: sh multipar.sh
==> lus2lic2.sum <==
-Test run by jahier on Wed Sep 22 11:33:52
+Test run by jahier on Mon Mar 21 11:40:45
Native configuration is x86_64-pc-linux-gnu
=== lus2lic2 tests ===
@@ -754,7 +754,7 @@ PASS: sh zzz2.sh
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus {}
==> lus2lic3.sum <==
-Test run by jahier on Wed Sep 22 11:34:19
+Test run by jahier on Mon Mar 21 11:41:50
Native configuration is x86_64-pc-linux-gnu
=== lus2lic3 tests ===
@@ -1269,7 +1269,7 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
==> lus2lic4.sum <==
-Test run by jahier on Wed Sep 22 11:35:01
+Test run by jahier on Mon Mar 21 11:42:45
Native configuration is x86_64-pc-linux-gnu
=== lus2lic4 tests ===
@@ -1761,7 +1761,7 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
# of expected failures 54
==> lus2lic1.sum <==
-PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus 45815 {}
+PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus 45823 {}
=== lus2lic1 Summary ===
@@ -1789,14 +1789,14 @@ PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus 45815
# of unexpected failures 6
===============================
# Total number of failures: 10
-lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 2 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 22 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 27 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 41 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 20 seconds
+lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 1 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 57 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 65 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 55 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 46 seconds
* Ref time:
-67.01user 14.41system 1:53.08elapsed 72%CPU (0avgtext+0avgdata 42044maxresident)k
-0inputs+143368outputs (0major+8228338minor)pagefaults 0swaps
+146.78user 35.50system 3:47.58elapsed 80%CPU (0avgtext+0avgdata 39292maxresident)k
+116968inputs+143008outputs (293major+8362985minor)pagefaults 0swaps
* Quick time (-j 4):
-105.55user 20.62system 0:51.79elapsed 243%CPU (0avgtext+0avgdata 42016maxresident)k
-5016inputs+140824outputs (5major+8137760minor)pagefaults 0swaps
+184.49user 40.01system 1:46.58elapsed 210%CPU (0avgtext+0avgdata 39216maxresident)k
+60192inputs+141800outputs (110major+8318029minor)pagefaults 0swaps