Commit 443d9cd8 authored by Erwan Jahier's avatar Erwan Jahier

Update the lus2lic plugin.

parent 3f34cfa4
......@@ -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 \
......
(** 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";
......
(** 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
(* 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
......
(* 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 *)
......
(* 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
......
(* 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
......
(* 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";
......
(* 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) =
......
(** 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
......
(* 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 = {
......
......@@ -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)
let rhs = { ve with ve_core = Merge(ce,cl)} in
if top_level then rhs, (eql, vl) else
(* create the var for the current call *)
let clk_l = ve.ve_clk in
let typ_l = ve.ve_typ in
assert (List.length typ_l = List.length clk_l);
let nv_l = List.map2 (new_var getid) typ_l clk_l in
let lxm = lxm_of_val_exp ve in
let vi2val_exp nv =
let _,clk = nv.var_clock_eff in
{
ve_core = CallByPosLic(Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,[]);
ve_typ = [nv.var_type_eff];
ve_clk = [clk];
}
in
let nve = match nv_l with
| [] -> assert false (* SNO *)
| [nv] -> vi2val_exp nv
| _ -> { ve with ve_core =
CallByPosLic(Lxm.flagit Lic.TUPLE lxm, List.map vi2val_exp nv_l)
}
in
let lpl = List.map (fun nv -> LeftVarLic(nv, lxm)) nv_l in
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
)
| CallByPosLic({it=Lic.VAR_REF _}, _) -> ve, ([],[])
| CallByPosLic({it=Lic.CONST_REF _}, _) -> ve, ([],[])
| CallByPosLic({src=lxm;it=Lic.CONST _}, _)
......@@ -333,7 +362,7 @@ and split_node (opt:Lv6MainArgs.t) (getid: LicPrg.id_generator) (n: Lic.node_exp
(List.length b.eqs_eff)(List.length neqs));
let (nasserts,neqs, nv) =
if opt.gen_autotest then
if opt.Lv6MainArgs.gen_autotest then
(* do not split assertions when generating lutin because we
would handle less assertions *)
(b.asserts_eff,neqs, nv)
......@@ -348,7 +377,7 @@ and split_node (opt:Lv6MainArgs.t) (getid: LicPrg.id_generator) (n: Lic.node_exp
(nasserts,neqs@neqs_asserts, nv@nv_asserts)
in
let neqs = List.map remove_tuple_from_eq neqs in
let nb = { b with eqs_eff = neqs ; asserts_eff = nasserts } in
let nb = { eqs_eff = neqs ; asserts_eff = nasserts } in
{ n with loclist_eff = Some nv; def_eff = BodyLic nb }
in
res
......
(* Time-stamp: <modified the 04/09/2014 (at 10:41) by Erwan Jahier> *)
(* Time-stamp: <modified the 16/01/2015 (at 10:08) by Erwan Jahier> *)
(** Split the equations of a node into several ones, in such a way
that there is only one operator per equation.
The rationale for doing that is to make the clock checking
trivial in the lic code (indeed, nested node call makes it
tricky).
We also split tuples. For example, the equation:
......
(* Time-stamp: <modified the 07/01/2015 (at 08:47) by Erwan Jahier> *)
(* Time-stamp: <modified the 20/01/2015 (at 16:04) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. By
compiled we mean that constant are propagated, packages are
......
(** Time-stamp: <modified the 07/01/2015 (at 16:18) by Erwan Jahier> *)
(** Time-stamp: <modified the 19/01/2015 (at 14:13) by Erwan Jahier> *)
(* XXX ce module est mal crit. A reprendre. (R1) *)
......@@ -7,7 +7,7 @@ open Lic
let dbg = (Verbose.get_flag "exec")
type action = ActionsDeps.action
type action = Action.t
(* Raised when a soc that haven't been translated yet is used in
another soc during the translation *)
......@@ -293,32 +293,20 @@ let (soc_key_of_node_exp : Lic.node_exp -> Soc.key) =
let (id,tl,key_opt) = make_soc_key_of_node_key n.node_key_eff None (List.map snd (svi@svo)) in
(id,tl,key_opt)
(* XXX duplicated code with get_leaf *)
let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
(* Translate val_exp into wires. XXX duplicated code with get_leaf *)
let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr list) =
fun licprg val_exp ->
let v = val_exp.Lic.ve_core in
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) -> assert false (* should not occur *)
| CallByNameLic(by_name_op_flg,fl) -> assert false (* SNO if correctly L2lSpitted *)
| Merge(c_flg, cl) -> assert false (* Should Not Occur if correctly L2lSpitted *)
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
| WHEN(e) -> (* ignore it. A good idea ? Such when should only appear for const *)
(match val_exp_list with
| [ve] -> val_exp_to_filter licprg ve
|_ -> assert false (* should not occur *)
)
List.flatten (List.map (val_exp_to_filter licprg) val_exp_list)
| TUPLE ->
(match val_exp_list with
| [ve] -> val_exp_to_filter licprg ve