Skip to content

GitLab

L
lutin
Commit 443d9cd8 authored by Erwan Jahier's avatar Erwan Jahier
Browse files
Options

Update the lus2lic plugin.

parent 3f34cfa4
Hide whitespace changes
Inline Side-by-side
Showing with 375 additions and 303 deletions
source/Lurettetop/Makefile.comon
View file @ 443d9cd8
......@@ -45,6 +45,8 @@ SOC_SOURCES = \
$(OBJDIR)/socPredef.ml \
$(OBJDIR)/toposort.mli \
$(OBJDIR)/toposort.ml \
$(OBJDIR)/action.mli \
$(OBJDIR)/action.ml \
$(OBJDIR)/actionsDeps.mli \
$(OBJDIR)/actionsDeps.ml \
$(OBJDIR)/sortActions.mli \
......@@ -118,6 +120,10 @@ LUSTRE_SOURCES = \
$(OBJDIR)/ast2lic.mli \
$(OBJDIR)/ast2lic.ml \
$(OBJDIR)/misc.ml \
$(OBJDIR)/l2lCheckMemSafe.mli \
$(OBJDIR)/l2lCheckMemSafe.ml \
$(OBJDIR)/l2lOptimIte.mli \
$(OBJDIR)/l2lOptimIte.ml \
$(OBJDIR)/l2lCheckLoops.mli \
$(OBJDIR)/l2lCheckLoops.ml \
$(OBJDIR)/l2lCheckOutputs.mli \
......
source/lus2lic/actionsDeps.ml
View file @ 443d9cd8
(** Time-stamp: <modified the 06/01/2015 (at 10:52) by Erwan Jahier> *)
(** Time-stamp: <modified the 15/01/2015 (at 10:51) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "deps")
(* exported *)
type rhs = Soc.var_expr list
type lhs = Soc.var_expr list
type action = Lic.clock * rhs * lhs * Soc.atomic_operation * Lxm.t
(*********************************************************************************)
let string_of_action: (action -> string) =
fun (c, i, o, p, lxm) ->
(* Version surchargée de Soc.string_of_operation pour afficher les "=" *)
let string_of_operation = function
| Soc.Assign -> ""
| op -> SocUtils.string_of_operation op
in
let string_of_params p = String.concat ", " (List.map SocUtils.string_of_filter p) in
if o = [] then
Format.sprintf "%s(%s)" (string_of_operation p) (string_of_params i)
else
Format.sprintf "%s = %s(%s) on %s"
(string_of_params o)
(string_of_operation p) (string_of_params i) (Lic.string_of_clock c)
let string_of_action_simple: (action -> string) =
fun (c, i, o, p,_) ->
(* Version surchargée de SocUtils.string_of_operation : l'objectif est d'afficher,
en cas de cycle combinatoire, un message d'erreur qui parle le plus possible
à l'utilisateur qui a programmé en V6... Pour cela le mieux (je pense) est
simplement de rendre la variable sur laquelle porte le cycle
*)
let string_of_operation = function
| Soc.Assign -> ""
| Soc.Method((n, sk),sname) -> n
| Soc.Procedure(name,_,_) -> name
in
let string_of_params p = String.concat ", " (List.map SocUtils.string_of_filter p) in
if o = [] then
Format.sprintf "%s(%s)"
(string_of_operation p)
(string_of_params i)
else
Format.sprintf "%s = %s(%s)"
(string_of_params o)
(string_of_operation p)
(string_of_params i)
type action = Action.t
(*********************************************************************************)
module OrderedAction = struct
......@@ -201,7 +156,7 @@ let rec (actions_of_vars: Soc.var_expr list -> var2actions_tbl -> action list) =
let string_of_actions: Actions.t -> string = fun s ->
let to_string a acc =
acc ^ (string_of_action a) ^ " ; "
acc ^ (Action.to_string a) ^ " ; "
in
"Actions(" ^ (Actions.fold to_string s "") ^ ")"
......@@ -219,7 +174,7 @@ let to_string: t -> string = fun m ->
let to_string key value acc =
let entry =
Format.sprintf "%s \n depends on \" %s \""
(string_of_action key)
(Action.to_string key)
(string_of_actions value)
in
acc ^ entry ^ "\n"
......@@ -255,7 +210,7 @@ let build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list ->
al
in
Verbose.exe ~flag:dbg (fun () ->
let al_str = List.map string_of_action al in
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";
......
source/lus2lic/actionsDeps.mli
View file @ 443d9cd8
(** Time-stamp: <modified the 06/10/2014 (at 10:45) by Erwan Jahier> *)
(** Time-stamp: <modified the 15/01/2015 (at 10:43) by Erwan Jahier> *)
(** Compute dependencies between actions *)
......@@ -11,30 +11,6 @@ val empty : t
val concat: t -> t -> t
(** An action is an intermediary data type that is used to translate expressions
into [Soc.gao]. It is basically a clocked Soc.atomic_operation with arguments.
The idea is that each expression is translated into one or several actions.
And those clocks are then translated into guards, so that each action is
translated into a gao.
A more natural Module to define that type in would have been Soc, but that
module is meant to be shared with other front-ends (e.g., lucid-synchrone),
and I prefer that module not to depend on
- such a cutting (expr -> action -> gao)
- The [Eff.clock] name (could have been a module parameter though).
*)
type rhs = Soc.var_expr list
type lhs = Soc.var_expr list
type action = Lic.clock * rhs * lhs * Soc.atomic_operation * Lxm.t
val string_of_action_simple: action -> string
(** Compute the action dependencies that comes from the I/O.
Construit des dépendances entre les actions en reliant les entrées et
......@@ -42,17 +18,17 @@ val string_of_action_simple: action -> string
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 list -> t
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'
in memory SOC).
*)
val generate_deps_from_step_policy: Soc.precedence list -> (string * action) list -> t
val generate_deps_from_step_policy: Soc.precedence list -> (string * Action.t) list -> t
(** Returns the list of actions that depends on the action in argument. *)
val find_deps: t -> action -> action list
val have_deps : t -> action -> bool
val remove_dep : t -> action -> t
val find_deps: t -> Action.t -> Action.t list
val have_deps : t -> Action.t -> bool
val remove_dep : t -> Action.t -> t
val to_string: t -> string
source/lus2lic/ast2lic.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 01/09/2014 (at 11:22) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 17:00) by Erwan Jahier> *)
open Lxm
......@@ -124,7 +124,7 @@ let do_abstract_static_param x =
match x.it with
| StaticParamType id -> ASP_type id
| StaticParamConst (id,_) -> ASP_const id
| StaticParamNode (id,_,_,_) -> ASP_node id
| StaticParamNode (id,_,_,_,_) -> ASP_node id
let get_abstract_static_params
......@@ -279,7 +279,7 @@ and check_static_arg
NodeStaticArgLic (id, neff.node_key_eff)
(* node exp vs node *)
| (StaticArgNode (Predef_n (op)), ASP_node id) ->
let opeff = LicEvalType.make_node_exp_eff node_id_solver None op.it sa.src in
let opeff = LicEvalType.make_node_exp_eff node_id_solver None true op.it sa.src in
NodeStaticArgLic (id, opeff.node_key_eff)
| (_, ASP_type _) -> nature_error "type"
| (_, ASP_const _) -> nature_error "constant"
......@@ -584,7 +584,7 @@ and node_of_static_arg id_solver node_or_node_ident lxm =
| StaticArgNode(CALL_n ne) -> of_node id_solver ne
| StaticArgNode(Predef_n (op)) ->
LicEvalType.make_node_exp_eff id_solver None op.it lxm
LicEvalType.make_node_exp_eff id_solver None true op.it lxm
| StaticArgNode(_) -> assert false
......
source/lus2lic/astCore.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 26/08/2014 (at 16:06) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 16:59) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source Lustre Core programs. *)
......@@ -31,14 +31,14 @@ and node_info = {
loc_consts : (Lxm.t * const_info) list;
def : node_def;
has_mem : bool;
is_safe : bool;
is_safe : bool; (* safe <=> no side-effect are performed *)
}
and static_param =
| StaticParamType of Ident.t
| StaticParamConst of Ident.t * type_exp
| StaticParamNode of
(Ident.t * var_info srcflagged list * var_info srcflagged list * has_mem_flag)
(Ident.t * var_info srcflagged list * var_info srcflagged list * has_mem_flag * is_safe_flag)
and node_vars = {
inlist : Ident.t list;
......@@ -70,6 +70,7 @@ and node_body = {
eqs : (eq_info srcflagged) list;
}
and has_mem_flag = bool
and is_safe_flag = bool
and eq_info = (left_part list * val_exp)
......@@ -149,6 +150,7 @@ and static_arg =
| StaticArgIdent of Ident.idref
| StaticArgConst of val_exp
| StaticArgType of type_exp
| StaticArgNode of by_pos_op
(* | StaticArgFunc of node_exp *)
......
source/lus2lic/astInstanciateModel.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 11/04/2013 (at 15:47) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 16:47) by Erwan Jahier> *)
open Lxm
open AstV6
......@@ -79,7 +79,7 @@ let (check_arg :
put_in_tab "const" ctab s y ;
((ConstItem s)::defs, x::prov)
)
| StaticParamNode (s, inl, outl, has_memory) -> (
| StaticParamNode (s, inl, outl, has_memory, is_safe) -> (
let arg = find_arg s in
let by_pos_op = match (arg.it) with
| StaticArgIdent idr -> CALL_n(Lxm.flagit ((idr,[])) arg.src)
......@@ -94,7 +94,7 @@ let (check_arg :
loc_consts = [];
def = Alias (flagit by_pos_op arg.src);
has_mem = has_memory;
is_safe = true;
is_safe = is_safe;
}
in
let x = Lxm.flagit (NodeInfo ni) param.src in
......
source/lus2lic/astV6Dump.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 24/04/2013 (at 17:25) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 16:56) by Erwan Jahier> *)
open Lxm
......@@ -197,8 +197,9 @@ and dump_static_param
| StaticParamType id -> fprintf os "type %s" (Ident.to_string id)
| StaticParamConst (id, exp) -> fprintf os "const %s : %a"
(Ident.to_string id) dump_type_exp exp
| StaticParamNode (id, ins, outs, has_mem) -> (
fprintf os "%s %s(@,%a@,)returns(@,%a@,)"
| StaticParamNode (id, ins, outs, has_mem,is_safe) -> (
fprintf os "%s%s %s(@,%a@,)returns(@,%a@,)"
(if is_safe then "" else "unsafe ")
(if has_mem then "node" else "function")
(Ident.to_string id)
dump_line_var_decl_list ins dump_line_var_decl_list outs
......
source/lus2lic/compile.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 02/10/2014 (at 11:41) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 15:15) by Erwan Jahier> *)
open Lxm
open Lv6errors
......@@ -41,21 +41,30 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
in
info "Converting to lic_prg...\n";
let zelic = LicTab.to_lic_prg lic_tab in
info "Check safety and memory declarations...\n";
L2lCheckMemSafe.doit zelic;
let zelic =
if not opt.Lv6MainArgs.optim_ite then zelic else (
info "Optimizing if/then/else...\n";
L2lOptimIte.doit zelic)
in
let zelic =
(* limination polymorphisme surcharge *)
info "Removing polymorphism...\n";
let zelic = L2lRmPoly.doit zelic in
info "Removing polymorphism...\n";
L2lRmPoly.doit zelic
in
let zelic = if not opt.Lv6MainArgs.inline_iterator then zelic else (
info "Inlining iterators...\n";
(* to be done before array expansion otherwise they won't be expanded *)
L2lExpandMetaOp.doit zelic
)
in
let zelic =
if
Lv6MainArgs.global_opt.Lv6MainArgs.one_op_per_equation
let zelic =
if
Lv6MainArgs.global_opt.Lv6MainArgs.one_op_per_equation
|| opt.Lv6MainArgs.expand_nodes (* expand performs no fixpoint, so it will work
only if we have one op per equation...*)
then (
then (
(* Split des equations (1 eq = 1 op) *)
info "One op per equations...\n";
L2lSplit.doit opt zelic)
......@@ -85,7 +94,7 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
if opt.Lv6MainArgs.expand_nodes then
(if long_match_idref long mn then (long,sargs)::acc else acc)
else if
List.exists (long_match_idref long) ids_to_expand
List.exists (long_match_idref long) ids_to_expand
then
acc
else
......@@ -116,11 +125,11 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
info "Aliasing arrays...\n";
let zelic = L2lAliasType.doit zelic in
*)
(* Currently only works in this mode *)
if Lv6MainArgs.global_opt.Lv6MainArgs.ec then (
info "Check loops...\n";
L2lCheckLoops.doit zelic);
L2lCheckLoops.doit zelic
);
info "Check unique outputs...\n";
L2lCheckOutputs.doit zelic;
info "Lic Compilation done!\n";
......
source/lus2lic/l2lCheckLoops.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 13/08/2014 (at 16:24) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/01/2015 (at 14:37) by Erwan Jahier> *)
open Lxm
open Lv6errors
......@@ -117,7 +117,6 @@ let (check_node : Lic.node_exp -> unit) =
let f id _ vi = visit deps vi id [] in
ignore (IdMap.fold f deps vi)
exception Compile_error_gen of Lxm.t * string
(* exported *)
let (doit : LicPrg.t -> unit) =
......
source/lus2lic/l2lExpandArrays.ml
View file @ 443d9cd8
(** Time-stamp: <modified the 03/09/2014 (at 10:55) by Erwan Jahier> *)
(** Time-stamp: <modified the 14/01/2015 (at 14:53) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be nested, it migth be a lot of new variables...
......@@ -219,10 +219,28 @@ let (expand_left : local_ctx -> left -> left list) =
in
flatten_var_tree vt
let rec unfold i x = if i < 0 then [] else x::(unfold (i-1) x)
let rec (expand_array_types : Lic.type_ list -> Lic.type_ list) =
fun tl ->
(* arrays are transformed into tuples *)
List.flatten (List.map aux tl)
and
(aux :Lic.type_ -> Lic.type_ list) = function
| Array_type_eff(st,i) -> unfold i st
| t -> [t]
(* arrays within abstract and struct won't be translated.
XXX should i raise an error saying that -esa is not
compatible with structure of arrays (instead of silently
returns arrays) ? To handle them, i would need to modify
Lic.type_ and to replace 'type_' by 'type_ list' in all
the recursive cases. It would be quite a lot of work and
-esa is not a useful option anymore... *)
(********************************************************************************)
(** build a new loc that will alias ve, and add its definition in the
set of equations (cf acc) *)
set of equations (cf acc) *)
let rec (make_new_loc : local_ctx -> Lxm.t -> acc -> Lic.val_exp
-> acc * var_info) =
fun lctx lxm acc ve ->
......@@ -243,7 +261,7 @@ and (var_trees_of_val_exp :
let id = prefix in
{
ve_core = CallByPosLic({src=lxm;it=(VAR_REF id)}, []);
ve_typ = [vi.var_type_eff] ;
ve_typ = [teff] ;
ve_clk = [snd vi.var_clock_eff]
}
in
......@@ -316,7 +334,7 @@ and (var_trees_of_val_exp :
| HAT(_) | CONCAT | ARRAY
| PREDEF_CALL _ | CALL _
| PRE | ARROW | FBY | CURRENT _ | WHEN _ | TUPLE -> (
(* Create a new loc var to alias such expressions *)
(* Create a new loc var to alias such expressions *)
let acc, nloc = make_new_loc lctx lxm acc ve in
acc, gen_var_trees (make_val_exp lxm nloc) "" nloc.var_type_eff
)
......@@ -333,7 +351,7 @@ and do_const acc lctx lxm const =
let ve_const,acc =
match ve_const.ve_core with
| CallByPosLic ({it=CONST_REF _},_) ->
(* in order to avoid a potential infinite loop *)
(* in order to avoid a potential infinite loop *)
(ve_const, acc)
| _ -> expand_val_exp lctx acc ve_const
......@@ -342,9 +360,9 @@ and do_const acc lctx lxm const =
and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list) =
fun lxm left_list ve ->
(* Note that this work only if the node expansion has already
been done! (otherwise, we would not have the same number of
items in the left and in the rigth part) *)
(* Note that this work only if the node expansion has already
been done! (otherwise, we would not have the same number of
items in the left and in the rigth part) *)
let rec aux ve = (* flatten val exp*)
match ve.ve_core with
| CallByPosLic ({it= TUPLE}, vel)
......@@ -408,8 +426,8 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
else
let vel = aux ve in
if (List.length vel <> lll) then
(* migth occur for generic nodes, that needs to be compiled,
but that will not be dumped. *)
(* migth occur for generic nodes, that needs to be compiled,
but that will not be dumped. *)
[{ src = lxm ; it = (left_list, ve) }]
else
List.map2
......@@ -455,16 +473,17 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
match by_pos_op with
| HAT(i) -> (
let ve, acc = expand_val_exp lctx acc (List.hd vel) in
let rec unfold cpt =
if cpt = 0 then [] else ve::(unfold (cpt-1))
let rec unfold (cpt, ve_acc) =
if cpt = 0 then ve_acc else (unfold (cpt-1, ve::ve_acc))
in
TUPLE, acc, unfold i
let ve = unfold (i,[]) in
TUPLE, acc, ve
)
| CONCAT | PREDEF_CALL _ | CALL _
| PRE | ARROW | FBY | CURRENT _ | WHEN _ | TUPLE | CONST _
->
let vel,acc = expand_val_exp_list lctx acc vel in
by_pos_op, acc, vel
by_pos_op, acc, vel
| ARRAY ->
let vel,acc = expand_val_exp_list lctx acc vel in
TUPLE, acc,vel
......@@ -475,21 +494,25 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
| CONST_REF _ ->
let acc, vt = try var_trees_of_val_exp lctx acc ve
with (Not_found | Failure _) ->
assert false (* just a defense against nth and assoc *)
assert false (* SNO: a defense against nth and assoc *)
in
TUPLE, acc, flatten_var_tree vt
TUPLE, acc, flatten_var_tree vt
in
let newve = CallByPosLic(Lxm.flagit by_pos_op lxm, vel) in
let newve = { ve with ve_core = newve } in
(* if newve.core <> ve.core then ( *)
(* EvalClock.copy newve ve *)
(* ); *)
let newve = { ve with
ve_core = newve ;
ve_typ = expand_array_types ve.ve_typ;
}
in
(* if newve.core <> ve.core then ( *)
(* EvalClock.copy newve ve *)
(* ); *)
newve, acc
| CallByNameLic(by_name_op, fl_val) ->
(* we want to print fields in the order of the type.
Moreover, we have to deal with default value.
*)
(* we want to print fields in the order of the type.
Moreover, we have to deal with default value.
*)
let teff = ve.ve_typ in
match teff with
| [Struct_type_eff(_,fl)] ->
......@@ -504,7 +527,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
with Not_found ->
match const_opt with
| None -> assert false
(* ougth to have been checked before *)
(* ougth to have been checked before *)
| Some const ->
let s, ve_const = (* XXX *)
UnifyClock.const_to_val_eff lxm true
......@@ -524,9 +547,9 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
ve_core= CallByPosLic({ src=lxm ; it=TUPLE }, (List.rev vel))
}
in
(* if newve.core <> ve.core then ( *)
(* EvalClock.copy newve ve *)
(* ); *)
(* if newve.core <> ve.core then ( *)
(* EvalClock.copy newve ve *)
(* ); *)
newve, acc
| _ -> assert false
......@@ -563,10 +586,10 @@ and (expand_var_info: local_ctx -> var_info list * acc ->
let new_var = clone_var lctx vi ("_" ^ soi i) at in
let new_vil, new_acc = expand_var_info lctx (vil,acc) new_var in
if new_vil = new_var::vil then (
(* [new_var] type is not made of structure *)
(* [new_var] type is not made of structure *)
assert (is_a_basic_type at);
(* XXX
Hashtbl.add nenv.lenv_vars new_var.var_name_eff new_var *)
(* XXX
Hashtbl.add nenv.lenv_vars new_var.var_name_eff new_var *)
);
local_aux (i+1) (new_vil, new_acc)
in
......
source/lus2lic/l2lExpandNodes.ml
View file @ 443d9cd8
(* Time-stamp: <modified the 09/10/2014 (at 17:31) by Erwan Jahier> *)
(* Time-stamp: <modified the 16/01/2015 (at 10:18) by Erwan Jahier> *)
open Lxm
......@@ -15,25 +15,7 @@ type local_ctx = {
}
(********************************************************************************)
(* stuff to create fresh var names.
XXX code dupl. with Split.new_var
*)
let new_var str lctx type_eff clock_eff =
let id = Ident.of_string (LicName.new_local_var str) in
let var =
{
var_name_eff = id;
var_nature_eff = AstCore.VarLocal;
var_number_eff = -1; (* this field is used only for i/o.
Should i rather put something sensible there ? *)
var_type_eff = type_eff;
var_clock_eff = clock_eff;
}
in
(* let clk_str = string_of_clock (snd clock_eff) in *)
(* print_string (" ===> creating "^id^ " from " ^ str^ " with clock " ^clk_str ^ "\n");flush stdout; *)
var
let new_var = LicName.new_var_info
(********************************************************************************)
let get_locals node =
......@@ -133,7 +115,7 @@ type acc =
let (mk_fresh_loc : local_ctx -> var_info -> clock -> var_info) =
fun lctx v c ->
new_var (Ident.to_string v.var_name_eff) lctx v.var_type_eff (fst v.var_clock_eff, c)
new_var (Ident.to_string v.var_name_eff) v.var_type_eff (fst v.var_clock_eff, c)
(* When expanding a node call such as
......@@ -294,10 +276,16 @@ and (expand_eq_aux: local_ctx -> Lic.eq_info -> local_ctx * acc option)=
and (expand_assert : local_ctx * acc -> val_exp srcflagged -> local_ctx * acc) =
fun (lctx, (a_acc,e_acc,v_acc)) ve ->
(* assert(ve);
is transformed into
assert_var=ve;
assert(assert_var);
where assert_var is a fresh new local var
*)
let lxm = ve.src in
let ve = ve.it in
let clk = Ident.of_string "dummy_expand_assert", BaseLic in
let assert_var = new_var "assert" lctx Bool_type_eff clk in
let assert_var = new_var "assert" Bool_type_eff clk in
let assert_eq = Lxm.flagit ([LeftVarLic(assert_var,lxm)], ve) lxm in
let assert_op = Lic.VAR_REF(assert_var.var_name_eff) in
let nve = {
......
source/lus2lic/l2lSplit.ml
View file @ 443d9cd8
......@@ -16,6 +16,9 @@ let info msg =
Verbose.exe ~flag:dbg (fun () -> Printf.eprintf "%4.4f: %s%!" t msg)
(********************************************************************************)
(* XXX use LicName.new_var_info *)
let new_var getid type_eff clock_eff =
let id = getid "v" in
let var =
......@@ -187,13 +190,39 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
is no "when"...
*)
match ve.ve_core with
| Merge(ce,cl) ->
| Merge(ce,cl) -> (
let ce,(eql1, vl1) = split_val_exp false false getid ce in
let const_l, vel = List.split cl in
let vel,(eql2, vl2) = split_val_exp_list false false getid vel in
let eql, vl = eql1@eql2, vl1@vl2 in
let cl = List.combine const_l vel in
{ ve with ve_core = Merge(ce,cl)}, (eql1@eql2, vl1@vl2)