Skip to content

GitLab

Commit 77e16ede authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Update the lus2lic plugin + minor improvements

parent d5ac6fe5
Hide whitespace changes
Inline Side-by-side
source/Gnuplot-rif/gnuplotRif.ml
View file @ 77e16ede
(*pp camlp4o *)
(* Time-stamp: <modified the 26/06/2015 (at 09:38) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
** This file may only be copied under the terms of the GNU Library General
......@@ -68,6 +69,13 @@ let (print_debug : string -> tok -> unit) =
flush stdout)
else
()
let (print_debug_str : string -> unit) =
fun msg->
if !verbose then (
output_string stdout msg;
flush stdout)
else
()
(********************************************************************************)
(* get var type in the rif file *)
......@@ -277,7 +285,11 @@ label_pos(i)=i*delta*1.7+delta/2
ignore
(List.fold_left
(fun (i,sep) var ->
if to_hide var then (i+1,sep) else (
if to_hide var then (
print_debug ("\n Skipping hidden var "^var);
(i+1,sep)
)
else (
put sep;
put_one_var var i;
(i+1,", \\\n ")
......
source/Lurettetop/Makefile.comon
View file @ 77e16ede
......@@ -121,6 +121,7 @@ LUSTRE_SOURCES = \
$(OBJDIR)/ast2lic.mli \
$(OBJDIR)/ast2lic.ml \
$(OBJDIR)/misc.ml \
$(OBJDIR)/l2lCheckKcgKeyWord.ml \
$(OBJDIR)/l2lCheckMemSafe.mli \
$(OBJDIR)/l2lCheckMemSafe.ml \
$(OBJDIR)/l2lOptimIte.mli \
......
source/Lutin/lutExe.ml
View file @ 77e16ede
......@@ -231,8 +231,7 @@ let of_expanded_code (opt:MainArg.t) (exped: Expand.t) = (
to ease te connection with the lucky solver.
*)
let make opt infile mnode = (
try (
(** open the file, compile and expand the main node ... *)
(** open the file, compile and expand the main node ... *)
let libs = MainArg.libs opt in
let mainprg =
assert (infile <> []);
......@@ -271,23 +270,7 @@ Verbose.put ~flag:dbg "LutExe.make: Expand.make %s OK\n" mnode;
of_expanded_code opt exped
else
exit 0
) with
Sys_error(s) -> (
prerr_string (s^"\n") ; exit 1
)
| LutErrors.Global_error s -> (
LutErrors.print_global_error s ; exit 1
)
| Parsing.Parse_error -> (
LutErrors.print_compile_error (Lexeme.last_made ()) "syntax error";
exit 1
)
| LutErrors.Compile_error(lxm,msg) -> (
LutErrors.print_compile_error lxm msg ; exit 1
)
| LutErrors.Internal_error (fname,msg) -> (
LutErrors.print_internal_error fname msg ; exit 1
)
)
(** Execution *)
......
source/Makefile
View file @ 77e16ede
......@@ -761,7 +761,7 @@ cp-comon:
install_assert: all_assert cp
install: all cp
install: all cp lutin-caml-install
allcp: clean all cp
test:
......@@ -773,18 +773,17 @@ cp-www:
cp ../pre_release/$(HOSTTYPE)/bin/lurettetop_exe ~/public_html/lurette/
# install lut4ocaml pour le labo
# install lut4ocaml pour le caml courant
# XXX ca serait bien de pouvoir se passer de polka, bdd, etc, en ayant tout dans lut4ocaml
# passer sous oasis ? il a l'air de savoir faire...
lutin-labo-install:
lutin-caml-install:
[ -d $(CAML_INSTALL_DIR)/../lutin ] || mkdir $(CAML_INSTALL_DIR)/../lutin
cp -f $(OBJDIR)/*lut4ocaml*.*a $(CAML_INSTALL_DIR)/../lutin || true
cp -f $(OBJDIR)/lutinRun.cm* $(CAML_INSTALL_DIR)/../lutin || true
cp -f $(OBJDIR)/*Ezdl_c_stubs* $(CAML_INSTALL_DIR)/../lutin || true
cp -rf ../pre_release/$(HOSTTYPE)/lib/*.* $(CAML_INSTALL_DIR)/../lutin || true
cp -rf ../pre_release/$(HOSTT YPE)/lib/*.so $(CAML_INSTALL_DIR)/../stublibs || true
cp -rf ../pre_release/$(HOSTTYPE)/lib/*.so $(CAML_INSTALL_DIR)/../stublibs || true
labo: lutin-labo-install
# copy my verimag install to www dirs
rdbg-www:
......
source/lus2lic/ast2lic.ml
View file @ 77e16ede
(* Time-stamp: <modified the 26/02/2015 (at 11:19) by Erwan Jahier> *)
(* Time-stamp: <modified the 25/06/2015 (at 17:32) by Erwan Jahier> *)
open Lxm
......@@ -112,6 +112,10 @@ TRAITER LES MACROS PREDEF :
partir des arguments donns et des args attendus.
- on cherche pas faire rentrer dans le moule, on dlgue
- 2015/07 -> probleme des node avec param statiques identifies par pack::node
c'etait pas prevu du tout ...
rajout du champs "all_srcs" dans le id solver qui premet de retrouver
n'importe quelle info source (un peu extreme comme solution ...)
*)
(* pour abstraire la nature des params statiques *)
......@@ -128,6 +132,7 @@ match x.it with
let get_abstract_static_params
(srcs: AstTab.t)
(symbols: AstTabSymbol.t)
(lxm: Lxm.t)
(idref: Lv6Id.idref)
......@@ -144,9 +149,22 @@ let get_abstract_static_params
| (Some "Lustre", "fillred") -> [ ASP_node "oper"; ASP_const "size" ]
| (Some "Lustre", "boolred") -> [ ASP_const "min"; ASP_const "max"; ASP_const "size"]
| (Some "Lustre", "condact") -> [ ASP_node "oper"; ASP_const "dflt" ]
| _ -> (
| (Some pck, nid) -> (
(* 2015/07 -> nouveau cas, on cherche les params statiques en tapant
directement dans le source *)
let packsrc = match AstTab.pack_prov_env srcs pck with
| Some ps -> ps
| None -> AstTab.pack_body_env srcs pck
in
let spl = match AstTabSymbol.find_node packsrc nid lxm with
| AstTabSymbol.Local ni -> ni.it.static_params
| _ -> assert false
in List.map do_abstract_static_param spl
)
| (None, nid) -> (
try
let spl = match AstTabSymbol.find_node symbols (Lv6Id.name_of_idref idref) lxm with
(* let spl = match AstTabSymbol.find_node symbols (Lv6Id.name_of_idref idref) lxm with *)
let spl = match AstTabSymbol.find_node symbols nid lxm with
| AstTabSymbol.Local ni -> ni.it.static_params
| AstTabSymbol.Imported(imported_node, params) -> params
in List.map do_abstract_static_param spl
......@@ -211,7 +229,7 @@ let rec of_node
| [] -> []
| _ ->
(* on en proffite pour corriger le idref en y rajoutant l'eventuel pack *)
let static_params = get_abstract_static_params id_solver.global_symbols lxm idref in
let static_params = get_abstract_static_params id_solver.all_srcs id_solver.global_symbols lxm idref in
let sp_l = List.length static_params
and sa_l = List.length static_args in
if (sp_l <> sa_l) then
......@@ -357,7 +375,7 @@ and (translate_val_exp_check : IdSolver.t -> Lic.clock list -> UnifyClock.subst
let s,vef = translate_val_exp id_solver s ve in
let lxm = AstCore.lxm_of_val_exp ve in
let lxms = List.map (fun _ -> lxm) exp_clks in
(* let vef, tl = EvalType.f id_solver vef in *)
(* let vef, tl = EvalType.f id_solver vef in *)
EvalClock.f id_solver s vef lxms exp_clks
......
source/lus2lic/astPredef.ml
View file @ 77e16ede
......@@ -93,7 +93,7 @@ let op2string = function
| AND_n -> "and"
| OR_n -> "or"
| XOR_n -> "xor"
| IMPL_n -> "=>"
| IMPL_n -> if Lv6MainArgs.global_opt.Lv6MainArgs.kcg then assert false else "=>"
| EQ_n -> "="
| NEQ_n -> "<>"
| LT_n | ILT_n | RLT_n -> "<"
......@@ -108,7 +108,7 @@ let op2string = function
| UMINUS_n -> "-"
| MINUS_n -> "-"
| PLUS_n -> "+"
| SLASH_n -> "/"
| SLASH_n -> if Lv6MainArgs.global_opt.Lv6MainArgs.kcg then "div" else "/"
| TIMES_n -> "*"
| IUMINUS_n -> "-"
| IMINUS_n -> "-"
......
source/lus2lic/astTab.ml
View file @ 77e16ede
(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
(* Time-stamp: <modified the 08/07/2015 (at 17:52) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de AstV6 pour mieux
......@@ -25,6 +25,9 @@ open AstV6
open AstCore
open Lv6errors
let dbg = (Verbose.get_flag "ast")
(** Package manager
Un package manager (pack_mng) contient les infos ``source'' du
......@@ -95,7 +98,7 @@ let (pack_body_env: t -> Lv6Id.pack_name -> AstTabSymbol.t) =
try
(Hashtbl.find this.st_pack_mng_tab p).pm_body_stab
with Not_found ->
print_string ("*** Can not find package '" ^
print_string ("*** Error: can not find package '" ^
(Lv6Id.pack_name_to_string p) ^ "' in the following packages: ");
Hashtbl.iter
(fun pn pm -> print_string ("\n***\t '"^(Lv6Id.pack_name_to_string pn)^ "'"))
......@@ -106,8 +109,11 @@ let (pack_body_env: t -> Lv6Id.pack_name -> AstTabSymbol.t) =
(* exported *)
let (pack_prov_env: t -> Lv6Id.pack_name -> Lxm.t -> AstTabSymbol.t option) =
fun this p lxm ->
let pack_prov_env
?(lxm:Lxm.t = Lxm.dummy "")
(this: t)
(p: Lv6Id.pack_name)
: AstTabSymbol.t option =
try (Hashtbl.find this.st_pack_mng_tab p).pm_provide_stab
with Not_found ->
(* let msg = *)
......@@ -144,7 +150,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'une const_info *)
let export_const (s:Lv6Id.t) (xci: AstCore.const_info srcflagged) =
Verbose.printf ~level:3 " export const %s\n" (Lv6Id.to_string s);
Verbose.printf ~flag:dbg " export const %s\n" (Lv6Id.to_string s);
put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Lv6Id.make_long pname s) xci.src)
......@@ -159,7 +165,7 @@ let init_user_items (this: pack_mng) = (
let treat_enum_const ec =
let s = ec.it in
let lxm = ec.src in
Verbose.printf ~level:3 " export enum const %s\n" (Lv6Id.to_string s);
Verbose.printf ~flag:dbg " export enum const %s\n" (Lv6Id.to_string s);
put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Lv6Id.make_long pname s) lxm)
......@@ -172,7 +178,7 @@ let init_user_items (this: pack_mng) = (
| ArrayType _
-> ()
);
Verbose.printf ~level:3 " export type %s\n" (Lv6Id.to_string s);
Verbose.printf ~flag:dbg " export type %s\n" (Lv6Id.to_string s);
put_in_tab "type" this.pm_user_items
(TypeItem s)
(Lxm.flagit (Lv6Id.make_long pname s) xti.src)
......@@ -180,7 +186,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'un node_info *)
let export_node (s: Lv6Id.t) (xoi: AstCore.node_info srcflagged) =
Verbose.printf ~level:3 " export node %s\n" (Lv6Id.to_string s);
Verbose.printf ~flag:dbg " export node %s\n" (Lv6Id.to_string s);
put_in_tab "node" this.pm_user_items
(NodeItem (s,xoi.it.static_params))
(Lxm.flagit (Lv6Id.make_long pname s) xoi.src)
......@@ -260,13 +266,13 @@ let rec (create : AstV6.pack_or_model list -> t) =
st_pack_mng_tab = Hashtbl.create 50;
}
in
Verbose.printf ~level:3 "*** AstTab.create pass 1\n";
Verbose.printf ~flag:dbg "*** AstTab.create pass 1\n";
(* passe 1 *)
init_raw_tabs res sl ;
(* passe 2 *)
Verbose.printf ~level:3 "*** AstTab.create pass 2\n";
Verbose.printf ~flag:dbg "*** AstTab.create pass 2\n";
let init_pack_mng pname pdata = (
Verbose.printf ~level:3 " init pack %s\n" (Lv6Id.pack_name_to_string pname);
Verbose.printf ~flag:dbg " init pack %s\n" (Lv6Id.pack_name_to_string pname);
let pg = AstInstanciateModel.f res.st_raw_mod_tab pdata in
Hashtbl.add res.st_pack_mng_tab
pname
......@@ -274,10 +280,10 @@ let rec (create : AstV6.pack_or_model list -> t) =
) in
Hashtbl.iter init_pack_mng res.st_raw_pack_tab ;
(* passe 3 *)
Verbose.printf ~level:3 "*** AstTab.create pass 3\n";
Verbose.printf ~flag:dbg "*** AstTab.create pass 3\n";
Hashtbl.iter (init_pack_mng_stabs res) res.st_pack_mng_tab ;
(* resultat *)
Verbose.printf ~level:3 "*** AstTab.create done\n";
Verbose.printf ~flag:dbg "*** AstTab.create done\n";
res
and
(***** PASSE 1 *****)
......@@ -321,7 +327,7 @@ and
init_pack_mng_stabs (this: t) (pname: Lv6Id.pack_name) (pm: pack_mng) = (
let pg = pm.pm_actual_src in
Verbose.printf ~level:3 " init symbol tables for pack %s\n"
Verbose.printf ~flag:dbg " init symbol tables for pack %s\n"
(Lv6Id.pack_name_to_string pname);
(* ON COMMENCE PAR TRAITER LE PG_USES *)
let treat_uses (px:Lv6Id.pack_name srcflagged) = (
......@@ -411,7 +417,8 @@ let find_node (genv: t) (pck: string) (idr: Lv6Id.t) =
(* exported *)
let (dump : t -> unit) =
fun x ->
let p = Verbose.print_string ~level:3 in
(* let p = Verbose.print_string ~level:3 in *)
let p = prerr_string in
p "*** « Syntax table dump:\n";
p " \t - Package or model list:\n\t\t";
......
source/lus2lic/astTab.mli
View file @ 77e16ede
......@@ -18,7 +18,7 @@ val create : AstV6.pack_or_model list -> t
val pack_body_env : t -> Lv6Id.pack_name -> AstTabSymbol.t
(** A package may have no provided part *)
val pack_prov_env : t -> Lv6Id.pack_name -> Lxm.t -> AstTabSymbol.t option
val pack_prov_env : ?lxm:Lxm.t -> t -> Lv6Id.pack_name -> AstTabSymbol.t option
(** Liste des noms de packs *)
val pack_list : t -> Lv6Id.pack_name list
......
source/lus2lic/astTabSymbol.ml
View file @ 77e16ede
......@@ -2,12 +2,31 @@
(**
Sous-module pour AstTab
AstTabSymbol.t =
tout ce qui concerne la résolution des idents "simples" (snas le pack::)
dans un contexte particulier.
Essentiellement, un ident simple qui apparait dans un contexte
est soit une reference locale (donc au pack courant)
soit une reference a un pack "importé" (via "uses", i.e. le open de caml !)
*)
open Lxm
open AstV6
open AstCore
open Lv6errors
let dbg = (Verbose.get_flag "ast")
(* get trace of raise Global_error in debug mode *)
let do_raise_global_error msg =
Verbose.printf ~flag:dbg "#DBG: up to raise global error:\n %s\n" msg;
raise (Global_error msg)
let do_raise_compile_error (lxm,msg) =
Verbose.printf ~flag:dbg "#DBG: up to raise compile error:\n %s: %s\n" (Lxm.details lxm) msg;
raise (Compile_error (lxm,msg))
type 'a elt =
| Local of 'a
| Imported of Lv6Id.long * static_param srcflagged list
......@@ -36,7 +55,11 @@ let find_type (this: t) (id: Lv6Id.t) lxm =
raise (Compile_error(lxm, "unknown type (" ^ (Lv6Id.to_string id)^")"))
let find_pack_of_type (this: t) (id: Lv6Id.t) lxm =
try fst (Hashtbl.find (this.st_types) id)
try
let res = fst (Hashtbl.find (this.st_types) id) in
Verbose.printf ~flag:dbg
"#DBG: AstTabSymbol.find_pack_of_type %s -> %s\n" id res;
res
with Not_found ->
raise (Compile_error(lxm, "unknown type (" ^ (Lv6Id.to_string id)^")"))
......@@ -47,7 +70,11 @@ let find_const (this: t) (id: Lv6Id.t) lxm =
raise (Unknown_constant(lxm, (Lv6Id.to_string id)))
let find_pack_of_const (this: t) (id: Lv6Id.t) lxm =
try fst (Hashtbl.find (this.st_consts) id)
try
let res = fst (Hashtbl.find (this.st_consts) id) in
Verbose.printf ~flag:dbg
"#DBG: AstTabSymbol.find_pack_of_const %s -> %s\n" id res;
res
with Not_found ->
raise (Unknown_constant(lxm, (Lv6Id.to_string id)))
......@@ -58,7 +85,8 @@ let find_node (this: t) (id: Lv6Id.t) lxm =
if Lxm.line lxm = 0 && Lxm.cend lxm = 0 then
(* A hack to print a nicer error msg when the node asked in the
command-line is not found in the input files*)
raise (Global_error("Can not find node " ^ (Lv6Id.to_string id)))
do_raise_global_error ("Can not find node " ^ (Lv6Id.to_string id))
(* raise (Global_error("Can not find node " ^ (Lv6Id.to_string id))) *)
else
let all_nodes =
Hashtbl.fold (fun n _ acc -> (Lv6Id.to_string n)::acc) this.st_nodes []
......@@ -66,7 +94,8 @@ let find_node (this: t) (id: Lv6Id.t) lxm =
let msg = "unknown node: " ^ (Lv6Id.to_string id)^"\n" ^
"*** known nodes are: " ^ (String.concat ", " all_nodes) ^ "\n"
in
raise (Compile_error(lxm, msg))
do_raise_compile_error (lxm, msg)
(* raise (Compile_error(lxm, msg)) *)
(* Manip de AstTabSymbol.t *)
......
source/lus2lic/astV6Dump.ml
View file @ 77e16ede
......@@ -6,7 +6,6 @@ open AstPredef
open AstV6
open AstCore
open Format
(***********************************************************************************)
(* exported *)
......
source/lus2lic/compile.ml
View file @ 77e16ede
(* Time-stamp: <modified the 03/03/2015 (at 14:30) by Erwan Jahier> *)
(* Time-stamp: <modified the 08/07/2015 (at 17:53) by Erwan Jahier> *)
open Lxm
open Lv6errors
......@@ -6,6 +6,7 @@ open AstV6
open AstCore
(* get the first package in the package/model list *)
let dbg = (Verbose.get_flag "ast")
let info msg =
let t = Sys.time() in
......@@ -28,7 +29,7 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> L
*)
let lic_tab = LicTab.create syntax_tab in
Verbose.exe ~level:2 (fun () -> AstTab.dump syntax_tab);
Verbose.exe ~flag:dbg (fun () -> AstTab.dump syntax_tab);
info "Compiling into lic...\n";
let lic_tab = match main_node with
......@@ -42,7 +43,10 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> L
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;
if Lv6MainArgs.global_opt.Lv6MainArgs.kcg then
L2lCheckKcgKeyWord.doit zelic
else
L2lCheckMemSafe.doit zelic;
let zelic =
if not opt.Lv6MainArgs.optim_ite then zelic else (
info "Optimizing if/then/else...\n";
......@@ -59,6 +63,12 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> L
L2lExpandMetaOp.doit zelic
)
in
let zelic =
if Lv6MainArgs.global_opt.Lv6MainArgs.kcg && not opt.Lv6MainArgs.inline_iterator then
L2lExpandMetaOp.doit_boolred zelic
else
zelic
in
let zelic =
if
Lv6MainArgs.global_opt.Lv6MainArgs.one_op_per_equation
......@@ -257,7 +267,7 @@ let (get_source_list : Lv6MainArgs.t -> string list -> AstV6.pack_or_model list)
let name =
try Filename.chop_extension (Filename.basename first_file)
with _ ->
print_string ("*** '"^first_file^"': bad file name.\n"); exit 1
print_string ("*** Error: '"^first_file^"' is a bad file name.\n"); exit 1
in
let pi = AstV6.give_pack_this_name (Lv6Id.pack_name_of_string name) unpacked_merged in
let p = NSPack (Lxm.flagit pi (Lxm.dummy name)) in
......
source/lus2lic/evalClock.ml
View file @ 77e16ede
(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
(* Time-stamp: <modified the 25/06/2015 (at 17:30) by Erwan Jahier> *)
open AstPredef
......@@ -224,13 +224,15 @@ let rec (f : IdSolver.t -> subst -> Lic.val_exp -> Lxm.t list -> Lic.clock list
let ve, inf_clks, s = f_aux id_solver s ve in
let s =
if exp_clks = [] then s else (
assert (List.length exp_clks = List.length inf_clks);
fold_left3
(fun s lxm eclk iclk -> UnifyClock.f s lxm eclk iclk)
s
lxms
exp_clks
(List.map (fun (_,clk) -> clk) inf_clks)
if (List.length exp_clks <> List.length inf_clks) then
raise (Compile_error(lxm_of_val_exp ve, "Bad arity"))
else
fold_left3
(fun s lxm eclk iclk -> UnifyClock.f s lxm eclk iclk)
s
lxms
exp_clks
(List.map (fun (_,clk) -> clk) inf_clks)
)
in
let inf_clks = List.map (fun (id,clk) -> id, apply_subst2 s clk) inf_clks in
......
source/lus2lic/genOcamlGlue.ml
View file @ 77e16ede
(* Time-stamp: <modified the 14/08/2014 (at 17:07) by Erwan Jahier> *)
(* Time-stamp: <modified the 08/07/2015 (at 17:53) by Erwan Jahier> *)
(* generate ocaml glue code that makes it possible to call lus2lic
from ocaml with the current set of arguments (with Lus2licRun.make).
......@@ -11,7 +11,7 @@ let (f: string array -> Lv6MainArgs.t -> unit) =
let file = List.hd opt.infiles in
try (Filename.chop_extension (Filename.basename file))^ ".ml"
with _ ->
print_string ("*** '"^file^"': bad file name.\n"); exit 2
print_string ("*** Error: '"^file^"'is a bad file name.\n"); exit 2
in
let cma_file = (Filename.chop_extension outfile) ^".cma" in
let remove_me = ["-exec"; "-ocaml";"-o";opt.outfile] in
......@@ -20,7 +20,7 @@ let (f: string array -> Lv6MainArgs.t -> unit) =
in
let args_str = "\"" ^ (String.concat "\";\"" args) ^"\"" in
let oc = open_out (outfile) in
Lv6util.dump_entete oc;
LicDump.dump_entete oc;
Printf.fprintf oc "
let plugin =
let args = Array.of_list [%s] in
......
source/lus2lic/idSolver.ml
View file @ 77e16ede
......@@ -9,7 +9,38 @@ type t = {
id2node : Lv6Id.idref -> Lic.static_arg list -> Lxm.t -> Lic.node_exp;
id2var : Lv6Id.t -> Lxm.t -> Lic.var_info;
(*
global_symbols ->
- la table à résoudre les idents SANS pack
(i.e. toto au lieu de Titi::toto) dans un pack courant :
c'est lié au mécanisme du "uses"
- normallement, elle est "cachée" dans les fonctions id2const, id2type, id2node ...
Pourtant on mise ici quand meme !!
Visiblement, sert dans 3 trucs :
- AstTabSymbol.find_pack_of_const
- AstTabSymbol.find_pack_of_type
et
- Ast2lic.get_abstract_static_params
pour les 2 premiers : pas sur a quoi ca sert, a creuser ...
pour le 3eme ->
ca sert uniquement a trouver la "nature" attendue
des params statiques (type const ou node) necessaire pour
calculer les parms effectif (et donc la cle des noeud a compiler)
dans Ast2lic.of_node
Mais c'est un bug : impossible de trouver avec elle les
params statiques d'un noeud appele avec son nom complet (Titi::toto) !
Donc, c'est pas ça qui faut ...
Solution (pas hyper satisfaisante) :
- ajouter le AstTab global, qui permet de retrouver nímporte quelle
source ... pas bien dans l'esprit "abstraire" mais bon...
- revoir si le global_symbols est vraiment necessaire ?
*)
global_symbols : AstTabSymbol.t;
all_srcs : AstTab.t;
}
type local_env = {
......
source/lus2lic/l2lCheckMemSafe.ml
View file @ 77e16ede
......@@ -141,5 +141,5 @@ let (doit : LicPrg.t -> unit) =
let rec (do_node : Lic.node_key -> Lic.node_exp -> unit) =
fun _nk ne -> check_node inprg ne
in
LicPrg.iter_nodes do_node inprg
LicPrg.iter_nodes do_node inprg
source/lus2lic/l2lExpandMetaOp.ml
View file @ 77e16ede
......@@ -484,25 +484,26 @@ let rec (create_meta_op_body: local_ctx -> Lic.node_key -> Lic.node_body * var_
| _,_ -> assert false
let rec (node : local_ctx -> Lic.node_exp -> Lic.node_exp) =
fun lctx n ->
let rec (node : local_ctx -> Lic.node_exp -> bool -> Lic.node_exp) =
fun lctx n only_boolred ->
let sonk = Lic.string_of_node_key in
Verbose.exe ~flag:dbg (fun () ->
Printf.printf "#DBG: L2lInlineMetaOp %s\n" (sonk n.node_key_eff));
match n.def_eff with
| MetaOpLic ->
| MetaOpLic ->
if only_boolred && (fst n.node_key_eff) <> ("Lustre", "boolred") then n else
let nk = n.node_key_eff in
let nbody, nlocs = create_meta_op_body lctx nk in
{ n with
def_eff = BodyLic nbody;
loclist_eff = Some nlocs;
}
| ExternLic
| AbstractLic None -> n
| AbstractLic (Some pn) ->
{ n with def_eff = AbstractLic (Some (node lctx pn)) }
| BodyLic b -> n
| ExternLic
| AbstractLic None -> n
| AbstractLic (Some pn) ->
{ n with def_eff = AbstractLic (Some (node lctx pn only_boolred)) }
| BodyLic b -> n
(* exported *)
let (doit : LicPrg.t -> LicPrg.t) =
fun inprg ->
......@@ -518,7 +519,28 @@ let (doit : LicPrg.t -> LicPrg.t) =
prg = inprg;
}
in
let ne = node lctx ne in
let ne = node lctx ne false in
LicPrg.add_node nk ne outprg
in
let outprg = LicPrg.fold_nodes do_node inprg outprg in
outprg
(* exported *)