Commit 8eb71ec8 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Adapt to the the rdbg-plugin/Data interface (delete alpha var) and update the lus2lic plugin

parent 365dd7ca
......@@ -53,6 +53,8 @@ SOC_SOURCES = \
$(OBJDIR)/socExecValue.ml \
$(OBJDIR)/socExecEvalPredef.mli \
$(OBJDIR)/socExecEvalPredef.ml \
$(OBJDIR)/socVar.mli \
$(OBJDIR)/socVar.ml \
$(OBJDIR)/socExec.mli \
$(OBJDIR)/socExec.ml
......
(* Time-stamp: <modified the 27/03/2014 (at 09:41) by Erwan Jahier> *)
(* Time-stamp: <modified the 16/06/2014 (at 16:05) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
*)
......@@ -41,8 +41,8 @@ let make argv =
)
in
let soc = try Soc.SocMap.find sk soc_tbl with Not_found -> assert false in
let soc_inputs = (SocExec.expand_profile true (fst soc.profile)) in
let soc_outputs = (SocExec.expand_profile true (snd soc.profile)) in
let soc_inputs = (SocVar.expand_profile true false (fst soc.profile)) in
let soc_outputs = (SocVar.expand_profile true false (snd soc.profile)) in
let (vntl_i:Data.vntl) = soc_inputs in
let (vntl_o:Data.vntl) = soc_outputs in
(* Lv6util.dump_entete oc; *)
......@@ -53,7 +53,7 @@ let make argv =
fun ctx vl ->
(* let sl = List.map (fun var -> fst var, SocExecValue.get_value ctx (Var var)) vl in *)
let sl = SocExecValue.filter_top_subst ctx.s in
let sl = List.flatten (List.map SocExec.expand_subst sl) in
let sl = List.flatten (List.map SocVar.expand_subst sl) in
(* If the order ever matters, I could try the following. :
try List.map (fun v -> fst v,
List.assoc (fst v) sl) vl with Not_found -> assert false
......@@ -62,7 +62,7 @@ let make argv =
in
let (add_subst : Data.subst list -> SocExecValue.substs -> SocExecValue.substs) =
fun s ctx_s ->
let s = SocExec.unexpand_profile s (fst soc.profile) in
let s = SocVar.unexpand_profile s (fst soc.profile) in
List.fold_left (fun acc (id,v) -> SocExecValue.sadd acc [id] v) ctx_s s
in
let ctx_ref = ref (SocExecValue.create_ctx soc_tbl soc) in
......
......@@ -410,8 +410,7 @@ lut4ocaml_assert:$(OBJDIR)
# local install
# cp -f $(OBJDIR)/lut4ocaml.top $(PRE_RELEASE_DIR)/bin || true
lut4ocaml-cp:
cp -f $(OBJDIR)/lut4ocaml.* $(PRE_RELEASE_DIR)/lib
cp -f $(OBJDIR)/liblut4ocaml*.a $(PRE_RELEASE_DIR)/lib
cp -f $(OBJDIR)/lutinRun.* $(PRE_RELEASE_DIR)/lib
# cp -f $(OBJDIR)/lut4ocaml_*.* $(PRE_RELEASE_DIR)/lib
......@@ -420,7 +419,7 @@ lut4ocaml-cp:
lut4ocaml-doc: $(OBJDIR)
cd $(OBJDIR) && ocamldoc -t "Lut4ocaml interface" -pp "camlp4o" \
-html -d $(SYNCHRONE_DIR)/lurette/doc/lut4ocaml/ \
-I ocamldoc -I $(OBJDIR) lut4ocaml.mli || true
-I ocamldoc -I $(OBJDIR)/lutinRun.mli || true
lut4ocaml-all: lut4ocaml lut4ocaml-doc lut4ocaml-cp
......@@ -652,7 +651,7 @@ endif
old: lucky luc2luciole luc4c liblucky_nc.a libluc4c_nc.a
compile_all: gen_version $(OBJDIR) gnuplot-rif gnuplot-socket call-via-socket draw-all $(LUCKY_DEF) lutin check-rif ltop lut4ocaml-clean lut4ocaml-all
compile_all: gen_version $(OBJDIR) gnuplot-rif gnuplot-socket call-via-socket lutin draw-all $(LUCKY_DEF) check-rif ltop lut4ocaml-clean lut4ocaml-all
rest: check-rif ltop lut4ocaml-clean lut4ocaml-all
allnc: clean lucky ltop show stubs gnuplot-rif gnuplot-socket call-via-socket gen_luc luc2luciole luc4c libluc4c_nc.a draw-all lut4ocaml-all check-rif
......
......@@ -38,7 +38,6 @@ let (go: module_name -> string -> typedef list -> vn_ct list -> vn_ct list ->
"#include <stdlib.h>\n" ^
"#include <stdio.h> \n" ^
"#include <ocaml2c.h>\n" ^
"#include <ocaml2c.h>\n" ^
"#include \"" ^ mod_name ^ ".h\" \n" ^
" \n") ;
......
(** Time-stamp: <modified the 17/05/2013 (at 17:45) by Erwan Jahier> *)
(** Time-stamp: <modified the 20/05/2014 (at 16:08) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "deps")
......@@ -28,16 +28,20 @@ let string_of_action: (action -> string) =
(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 que parle le plus possible
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
simplement de rendre la variable sur laquelle porte le cycle
*)
let string_of_operation = function
| Soc.Assign -> ""
| op -> SocUtils.string_of_operation op
| 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
......@@ -89,11 +93,11 @@ let (concat: t -> t -> t) =
(*********************************************************************************)
(* exported *)
let (generate_deps_from_step_policy:
let (generate_deps_from_step_policy:
Soc.precedence list -> (string * action) list -> t) =
fun precedences actions ->
let generate_deps_for_action:
(t -> string * string list -> t) =
(t -> string * string list -> t) =
fun ad (action_name, actions_needed) ->
let main_action = snd (List.find (fun (n, _) -> n = action_name) actions) in
let deps =
......@@ -256,3 +260,63 @@ let build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list ->
deps
(*********************************************************************************)
(* topological sort of actions *)
type color = Grey | Black (* in process | done *)
type color_table = color MapAction.t
exception DependencyCycle of action * action list
(* exception DependencyCycle of Soc.var_expr list *)
let (grey_actions : color_table -> action list) =
fun ct ->
MapAction.fold
(fun action color acc -> if color=Grey then action::acc else acc) ct []
let rec (visit : t -> color_table -> action -> color_table) =
fun succ_t color_t n ->
if not (MapAction.mem n succ_t) then MapAction.add n Black color_t else
let color_t =
Actions.fold
(fun nt color_t ->
try
match MapAction.find nt color_t with
| Grey -> raise (DependencyCycle (n, grey_actions color_t))
| Black -> color_t
with
(* The node [nt] is white *)
Not_found -> visit succ_t color_t nt
)
(MapAction.find n succ_t)
(MapAction.add n Grey color_t)
in
MapAction.add n Black color_t
(* TEDLT *)
let (check_there_is_no_cycle : action list -> t -> unit) =
fun actions t ->
List.iter (fun action -> ignore(visit t MapAction.empty action)) actions
let (topo_sort : action list -> t -> action list) =
fun actions succ_tbl ->
let visited_init =
List.fold_left (fun acc x -> MapAction.add x false acc) MapAction.empty actions
in
let rec f (acc:action list) (l:action list) (stbl:t) (visited:bool MapAction.t) =
(* The graph contains no cycle! *)
match l with
| [] -> List.rev acc
| x::tail ->
if (try MapAction.find x visited with Not_found -> assert false)
then
f acc tail stbl visited
else if (MapAction.mem x stbl) then
let x_succ = Actions.elements (MapAction.find x stbl) in
f acc (x_succ @ l) (MapAction.remove x stbl) visited
else
f (x::acc) tail stbl (MapAction.add x true visited)
in
check_there_is_no_cycle actions succ_tbl;
f [] actions succ_tbl visited_init
(** Time-stamp: <modified the 08/04/2013 (at 14:11) by Erwan Jahier> *)
(** Time-stamp: <modified the 11/12/2013 (at 17:49) by Erwan Jahier> *)
(** Compute dependencies between actions *)
......@@ -50,3 +50,7 @@ val generate_deps_from_step_policy: Soc.precedence list -> (string * action) lis
val find_deps: t -> action -> action list
val to_string: t -> string
exception DependencyCycle of action * action list
(* Topological sort of actions. Raises DependencyCycle if there is one. *)
val topo_sort : action list -> t -> action list
(* Time-stamp: <modified the 24/05/2013 (at 17:44) by Erwan Jahier> *)
(* Time-stamp: <modified the 12/06/2014 (at 09:42) by Erwan Jahier> *)
open Lxm
open Lv6errors
......@@ -7,8 +7,14 @@ open AstCore
(* get the first package in the package/model list *)
let info msg =
let t = Sys.time() in
Verbose.exe ~level:1 (fun () -> Printf.eprintf "%4.4f: %s%!" t msg)
let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
fun opt srclist main_node ->
let t0 = Sys.time() in
info "Start compiling to lic...\n";
let syntax_tab = AstTab.create srclist in
(* Pour chaque package, on a un solveur de rfrences
globales, pour les types, const et node :
......@@ -20,9 +26,11 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
. dans un des packs dclars "uses", avec
priorit dans l'ordre
*)
let lic_tab = LicTab.create syntax_tab in
Verbose.exe ~level:2 (fun () -> AstTab.dump syntax_tab);
info "Compiling into lic...\n";
let lic_tab = match main_node with
| None -> LicTab.compile_all lic_tab
| Some main_node ->
......@@ -31,48 +39,67 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
else
LicTab.compile_node lic_tab main_node
in
info "Converting to lic_prg...\n";
let zelic = LicTab.to_lic_prg lic_tab in
(* limination polymorphisme surcharge *)
info "Removing polymorphism...\n";
let zelic = L2lRmPoly.doit zelic in
(* alias des types array *)
(* let zelic = L2lAliasType.doit zelic in *)
let zelic = if not opt.Lv6MainArgs.inline_iterator then zelic else
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
L2lExpandMetaOp.doit zelic
)
in
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
only if we have one op per equation...*)
then (
(* Split des equations (1 eq = 1 op) *)
L2lSplit.doit zelic
info "One op per equations...\n";
L2lSplit.doit zelic)
else
zelic
in
let zelic = if not opt.Lv6MainArgs.expand_nodes then zelic else
L2lExpandNodes.doit opt.Lv6MainArgs.dont_expand_nodes zelic
let zelic = if not opt.Lv6MainArgs.expand_nodes then zelic else (
info "Expanding nodes...\n";
L2lExpandNodes.doit opt.Lv6MainArgs.dont_expand_nodes zelic)
in
(* Array and struct expansion: to do after polymorphism elimination *)
let zelic = if not opt.Lv6MainArgs.expand_arrays then zelic else
L2lExpandArrays.doit zelic
(* Array and struct expansion: to do after polymorphism elimination
and after node expansion *)
let zelic = if not opt.Lv6MainArgs.expand_arrays then zelic else (
info "Expanding arrays...\n";
L2lExpandArrays.doit zelic)
in
(* alias des types array XXX fait partir lic2soc en boucle
cause des soc key qui ne sont plus cohrentes entre elles
(cf commentaire au dbut du module). Bon, j'enleve, car j'en ai
pas vraiment besoin en plus.
info "Aliasing arrays...\n";
let zelic = L2lAliasType.doit zelic in
*)
(* Currently only works in this mode *)
if Lv6MainArgs.global_opt.Lv6MainArgs.ec then L2lCheckLoops.doit zelic;
if Lv6MainArgs.global_opt.Lv6MainArgs.ec then (
info "Check loops...\n";
L2lCheckLoops.doit zelic);
info "Check unique outputs...\n";
L2lCheckOutputs.doit zelic;
info "Lic Compilation done!\n";
zelic
let test_lex ( lexbuf ) = (
let tk = ref (Lv6lexer.lexer lexbuf) in
while !tk <> Lv6parser.TK_EOF do
match (Lv6lexer.token_code !tk) with
( co , lxm ) ->
Printf.printf "line %3d col %2d to %2d : %15s = \"%s\"\n"
(line lxm) (cstart lxm) (cend lxm) co (str lxm) ;
tk := (Lv6lexer.lexer lexbuf)
done
while !tk <> Lv6parser.TK_EOF do
match (Lv6lexer.token_code !tk) with
( co , lxm ) ->
Printf.printf "line %3d col %2d to %2d : %15s = \"%s\"\n"
(line lxm) (cstart lxm) (cend lxm) co (str lxm) ;
tk := (Lv6lexer.lexer lexbuf)
done
)
(* Retourne un AstV6.t *)
......
(* Time-stamp: <modified the 25/04/2013 (at 09:23) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/05/2014 (at 10:44) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
......@@ -190,6 +190,6 @@ type clk = long * t
let (string_of_clk : clk -> string) =
fun (cc,cv) ->
(long_to_string cc) ^ "(" ^ (to_string cv) ^ ")"
(string_of_long cc) ^ "(" ^ (to_string cv) ^ ")"
(*************************************************************************)
(* Time-stamp: <modified the 13/02/2013 (at 15:10) by Erwan Jahier> *)
(* Time-stamp: <modified the 12/06/2014 (at 09:28) by Erwan Jahier> *)
(**
Source 2 source transformation :
- toutes les expressions de type sans NOM
(donc uniquement des tableaux immédiats ?)
sont traquées et remplacées par un alias
XXX Ce module est buggué. Des expressions de type apparaissent
aussi dans les Lic.val_exp (via le champ ve_typ). Du coup, les
clefs sur les types (comme Soc.key) ne sont plus canoniques.
*)
open Lic
......@@ -54,15 +59,20 @@ let doit (inp : LicPrg.t) : LicPrg.t =
*)
ref_te
)
) | _ -> te
)
| Struct_type_eff (id, fields) ->
let do_field (id, (tf, co)) =
(id, (alias_type tf, co))
in
Struct_type_eff (id, List.map do_field fields)
| _ -> te
in
(** TRAITE LES TYPES *)
let do_type k te =
let te' = match te with
| Array_type_eff (tel, sz) ->
let tel' = alias_type tel in
Array_type_eff (tel', sz)
| Array_type_eff (t, sz) -> Array_type_eff (alias_type t, sz)
| Struct_type_eff (id, fields) ->
let do_field (id, (tf, co)) =
(id, (alias_type tf, co))
......@@ -123,6 +133,3 @@ let doit (inp : LicPrg.t) : LicPrg.t =
in
LicPrg.iter_nodes do_node inp;
!res
(** Time-stamp: <modified the 27/05/2013 (at 16:23) by Erwan Jahier> *)
(** Time-stamp: <modified the 26/05/2014 (at 10:39) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
......
(** Time-stamp: <modified the 04/06/2013 (at 14:43) by Erwan Jahier> *)
(** Time-stamp: <modified the 22/01/2014 (at 16:39) by Erwan Jahier> *)
open Lxm
open Lic
......@@ -104,6 +104,14 @@ let (binop_to_val_exp : Ident.t -> val_exp -> val_exp -> val_exp) =
ve_typ = ve1.ve_typ;
ve_core = CallByPosLic(op, [ve1; ve2])
}
let (binop_to_val_exp_bool : Ident.t -> val_exp -> val_exp -> val_exp) =
fun op ve1 ve2 ->
let op = { it = PREDEF_CALL({src=lxm;it=("Lustre",op),[]}) ; src = lxm } in
{
ve_clk = ve1.ve_clk;
ve_typ = [Bool_type_eff];
ve_core = CallByPosLic(op, [ve1; ve2])
}
let (fby_to_val_exp : val_exp -> val_exp -> val_exp) =
fun ve1 ve2 ->
let op = { it = FBY ; src = lxm } in
......@@ -302,11 +310,11 @@ let (create_boolred_body: local_ctx -> int -> int -> int -> Lic.node_body * var_
<=>
node toto(tab:bool^n) returns (res:bool);
var
cpt:int;
let
cpt = (if tab[0] then 1 else 0) + ... + (if tab[k-1] then 1 else 0);
res = i <= cpt && cpt <= j;
tel
cpt:int;
let
cpt = (if tab[0] then 1 else 0) + ... + (if tab[k-1] then 1 else 0);
res = i <= cpt && cpt <= j;
tel
*)
assert(0 <= i && i <= j && j <= k && k>0);
let (tab_vi : var_info) = match lctx.node.Lic.inlist_eff with
......@@ -336,8 +344,8 @@ let (create_boolred_body: local_ctx -> int -> int -> int -> Lic.node_body * var_
let i_eff = val_exp_of_int (string_of_int i) in
let j_eff = val_exp_of_int (string_of_int j) in
let cpt_eff = val_exp_of_var_info cpt_vi in
let i_inf_cpt = binop_to_val_exp "lte" i_eff cpt_eff in
let cpt_inf_j = binop_to_val_exp "lte" cpt_eff j_eff in
let i_inf_cpt = binop_to_val_exp_bool "lte" i_eff cpt_eff in
let cpt_inf_j = binop_to_val_exp_bool "lte" cpt_eff j_eff in
binop_to_val_exp "and" i_inf_cpt cpt_inf_j
in
let cpt_eq = { src = lxm ; it = ([cpt_left], cpt_rigth) } in
......
......@@ -11,6 +11,9 @@ open Lxm
open Lic
let dbg = (Verbose.get_flag "split")
let info msg =
let t = Sys.time() in
Verbose.exe ~flag:dbg (fun () -> Printf.eprintf "%4.4f: %s%!" t msg)
(********************************************************************************)
let new_var getid type_eff clock_eff =
......@@ -143,7 +146,7 @@ let (split_tuples:Lic.eq_info Lxm.srcflagged list -> Lic.eq_info Lxm.srcflagged
else
[eq]
in
List.flatten (List.map split_one_eq eql)
List.fold_left (fun acc eq -> List.rev_append (split_one_eq eq) acc) [] eql
(********************************************************************************)
(* The functions below accumulate
......@@ -157,12 +160,13 @@ let rec (eq : LicPrg.id_generator -> Lic.eq_info Lxm.srcflagged -> split_acc) =
let n_rhs, (neqs, nlocs) = split_val_exp false true getid rhs in
{ src = lxm_eq ; it = (lhs, n_rhs) }::neqs, nlocs
and (split_eq_acc :
and (split_eq_acc :
LicPrg.id_generator -> split_acc -> Lic.eq_info srcflagged -> split_acc) =
fun getid (eqs, locs) equation ->
fun getid (eqs, locs) equation ->
let (neqs, nlocs) = eq getid equation in
(split_tuples (eqs@neqs), locs@nlocs)
let neqs = split_tuples neqs in
List.rev_append neqs eqs, List.rev_append nlocs locs
and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
Lic.val_exp * split_acc) =
fun when_flag top_level getid ve ->
......@@ -308,8 +312,9 @@ and (split_val_exp_list : bool ->
and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
Verbose.exe ~flag:dbg (fun () ->
Printf.printf "*** Splitting node %s\n"
(LicDump.string_of_node_key_iter n.node_key_eff));
Printf.eprintf "*** Splitting node %s\n"
(LicDump.string_of_node_key_iter n.node_key_eff);
flush stderr);
let res = match n.def_eff with
| ExternLic
| MetaOpLic
......@@ -319,6 +324,9 @@ and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
| BodyLic b ->
let loc = match n.loclist_eff with None -> [] | Some l -> l in
let (neqs, nv) = List.fold_left (split_eq_acc getid) ([], loc) b.eqs_eff in
info (Printf.sprintf "Split %i equations into %i ones\n"
(List.length b.eqs_eff)(List.length neqs));
let asserts = List.map (fun x -> x.it) b.asserts_eff in
let lxm_asserts = List.map (fun x -> x.src) b.asserts_eff in
let nasserts,(neqs_asserts,nv_asserts) =
......@@ -353,8 +361,7 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(** TRAITE LES NOEUDS : *)
let rec do_node k (ne:Lic.node_exp) =
(* On passe en parametre un constructeur de nouvelle variable locale *)
Verbose.exe ~flag:dbg (fun() -> Printf.printf "#DBG: split equations of '%s'\n"
(Lic.string_of_node_key k));
info (Printf.sprintf "#DBG: split equations of '%s'\n" (Lic.string_of_node_key k));
let getid = LicPrg.fresh_var_id_generator inprg ne in
let ne' = split_node getid ne in
res := LicPrg.add_node k ne' !res
......
(** Time-stamp: <modified the 06/06/2013 (at 10:13) by Erwan Jahier> *)
(** Time-stamp: <modified the 25/06/2014 (at 14:38) by Erwan Jahier> *)
(* XXX ce module est mal crit. A reprendre. (R1) *)
open Lxm
open Lic
......@@ -47,9 +49,9 @@ let rec lic_to_data_type: (Lic.type_ -> Data.t) =
Data.Struct(id, List.map trans_field fl)
)
| Lic.Array_type_eff(ty,i) -> Data.Array(lic_to_data_type ty,i)
| Lic.Abstract_type_eff (id, _) -> assert false
| Lic.TypeVar Lic.Any -> Data.Alpha 0
| Lic.TypeVar Lic.AnyNum -> Data.Alpha 1
| Lic.Abstract_type_eff (id, t) -> Data.Alias(Ident.string_of_long id,lic_to_data_type t)
| Lic.TypeVar Lic.Any -> assert false (* Data.Alpha 0 *)
| Lic.TypeVar Lic.AnyNum -> assert false (* Data.Alpha 1 *)
(*********************************************************************************)
(** Renomme une variable dfinie par l'utilisateur.
......@@ -258,18 +260,29 @@ let soc_profile_of_node: Lic.node_exp -> Soc.var list * Soc.var list =
let outputs = List.map lic_to_soc_var n.Lic.outlist_eff in
inputs, outputs
let (make_soc_key_of_node_exp : Lic.node_key -> Lic.slice_info option -> Data.t list -> Soc.key) =
fun nk si_opt vl ->
LicDump.string_of_node_key_rec false nk, vl,
(match si_opt with
| None -> Soc.Nomore
| Some si -> Soc.Slic(si.Lic.se_first,si.Lic.se_last,si.Lic.se_step))
let (make_soc_key_of_node_key : Lic.node_key -> Lic.slice_info option -> Data.t list -> Soc.key) =
fun nk si_opt vl ->
let key_opt =
(match si_opt with
| None -> Soc.Nomore
| Some si -> Soc.Slic(si.Lic.se_first,si.Lic.se_last,si.Lic.se_step))
in
let key_opt =
if (snd (fst nk)) = "condact" then (
assert (key_opt=Soc.Nomore);
Soc.MemInit(Soc.Const("_true", Data.Bool)) (* the first step flag *)
) else (
key_opt
)
in
LicDump.string_of_node_key_rec false nk, vl, key_opt
let (soc_key_of_node_exp : Lic.node_exp -> Soc.key) =
fun n ->
let svi,svo = soc_profile_of_node n in
let sk = make_soc_key_of_node_exp n.node_key_eff None (List.map snd (svi@svo)) in
sk
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) =
......@@ -305,7 +318,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
| CONST Extern_const_eff _ -> assert false
| CONST Abstract_const_eff _ -> assert false
| CONST Enum_const_eff _ -> assert false
| CONST Struct_const_eff _ -> assert false
| CONST Struct_const_eff _ -> assert false
| CONST Array_const_eff _ -> assert false
| CONST Tuple_const_eff _ -> assert false
......@@ -329,7 +342,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
in
Soc.Index(filter_expr, i, type_)
)
| PREDEF_CALL _
| PREDEF_CALL _
| CALL _
| PRE
| ARROW
......@@ -342,7 +355,8 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
| ARRAY_SLICE _ ->
let lxm = by_pos_op_flg.src in
let msg = (Lxm.details lxm) ^
": only one operator per equation is allowed.\n"
": only one operator per equation is allowed ("^
(LicDump.string_of_val_exp_eff val_exp)^").\n"
in
raise (Lv6errors.Global_error msg)
)
......@@ -400,7 +414,7 @@ let (make_instance :
| [] -> (
match soc.Soc.have_mem with
| None -> ctx, None
| Some (_) -> (* pre/fby *)
| Some (_) -> (* pre/fby/arrow/condact *)
let ctx, m = create_instance_from_soc ctx soc in
ctx, Some(m)
)
......@@ -417,19 +431,20 @@ let (make_instance :
type e2a_acc = ctx * action list * Soc.var_expr list * Soc.instance list * ActionsDeps.t
(