From cf547959259419f9f51782c955076bd6037ded00 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Wed, 10 Apr 2013 10:55:04 +0200
Subject: [PATCH] Add a library that allow ldbg/lurettetop to call lus2lic.
Also Merge the Global and the MainArg module as they were
(bizzarely) both handling command args options.
---
Makefile | 65 +-
Makefile.common | 34 ++
Makefile.lib4lurette | 7 +
src/compile.ml | 149 ++++-
src/compile.mli | 8 +-
src/event.ml | 1 +
src/expr.ml | 1 +
src/failure.ml | 3 +
src/global.ml | 52 --
src/ident.ml | 10 +-
src/l2lExpandArrays.ml | 4 +-
src/l2lExpandNodes.ml | 10 +-
src/l2lExpandNodes.mli | 6 +-
src/lic.ml | 6 +-
src/lic2soc.ml | 3 +-
src/licDump.ml | 29 +-
src/licPrg.ml | 30 +-
src/licPrg.mli | 4 +-
src/lpp-dot.ps | 1304 ----------------------------------------
src/lpp.dot | 54 --
src/lus2licRun.ml | 96 +++
src/lus2licRun.mli | 9 +
src/lxm.ml | 21 +-
src/main.ml | 203 ++-----
src/mainArgs.ml | 177 ++++--
src/mainArgs.mli | 37 +-
src/socExec.ml | 60 +-
src/socExec.mli | 11 +-
src/socExecValue.ml | 2 +-
src/socExecValue.mli | 2 +-
test/lus2lic.sum | 2 +-
31 files changed, 622 insertions(+), 1778 deletions(-)
create mode 100644 Makefile.common
create mode 100644 Makefile.lib4lurette
create mode 120000 src/event.ml
create mode 120000 src/expr.ml
create mode 100644 src/failure.ml
delete mode 100644 src/global.ml
delete mode 100644 src/lpp-dot.ps
delete mode 100644 src/lpp.dot
create mode 100644 src/lus2licRun.ml
create mode 100644 src/lus2licRun.mli
diff --git a/Makefile b/Makefile
index 1f54a6eb..38b0bbea 100644
--- a/Makefile
+++ b/Makefile
@@ -1,38 +1,9 @@
all: doit
-curdir=$(shell pwd)
+include ./Makefile.common
-OBJDIR=./obj$(HOSTTYPE)
-SRCDIR=./src
-
-LN=ln -s
-$(OBJDIR)/% : $(SRCDIR)/%
- rm -f $@; cd $(OBJDIR) && $(LN) ../$(SRCDIR)/$* . && cd $(curdir)
-
-$(OBJDIR):
- mkdir $(OBJDIR)
-
-OCAMLMAKEFILE = ./OCamlMakefile
-RESULT=$(OBJDIR)/lus2lic$(EXE)
-
-LIBS = str unix
-
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
-
-ifeq ($(HOSTTYPE),win32)
- OCAMLC=/usr/i586-mingw32msvc/bin/ocamlc
- OCAMLOPT=/usr/i586-mingw32msvc/bin/ocamlopt
- OCAMLDEP=/usr/i586-mingw32msvc/bin/ocamldep
- OCAMLRUN=/usr/i586-mingw32msvc/bin/ocamlrun
- OCAMLLIB = `/usr/i586-mingw32msvc/bin/ocamlc -where`
-endif
-
-ifeq ($(HOSTTYPE),cygwin)
-CFLAGS=-mno-cygwin
-endif
SOC_SOURCES = \
$(OBJDIR)/data.mli \
@@ -58,7 +29,7 @@ SOC_SOURCES = \
$(OBJDIR)/socExec.ml
-SOURCES = \
+COMPILER_SOURCES = \
$(OBJDIR)/version.ml \
$(OBJDIR)/verbose.mli \
$(OBJDIR)/genlex.mli \
@@ -66,7 +37,8 @@ SOURCES = \
$(OBJDIR)/verbose.ml \
$(OBJDIR)/filenameExtras.mli \
$(OBJDIR)/filenameExtras.ml \
- $(OBJDIR)/global.ml \
+ $(OBJDIR)/mainArgs.ml \
+ $(OBJDIR)/mainArgs.mli \
$(OBJDIR)/ident.mli \
$(OBJDIR)/ident.ml \
$(OBJDIR)/lxm.mli \
@@ -135,11 +107,26 @@ SOURCES = \
$(OBJDIR)/l2lSplit.ml \
$(OBJDIR)/licTab.ml \
$(OBJDIR)/licTab.mli \
+ $(OBJDIR)/compile.mli \
$(OBJDIR)/compile.ml \
- $(OBJDIR)/mainArgs.ml \
- $(OBJDIR)/mainArgs.mli \
+
+SOURCES = \
+ $(COMPILER_SOURCES) \
$(OBJDIR)/main.ml
+LDBG_SOURCES = \
+ $(COMPILER_SOURCES) \
+ $(OBJDIR)/failure.ml \
+ $(OBJDIR)/expr.ml \
+ $(OBJDIR)/event.ml \
+ $(OBJDIR)/lus2licRun.mli \
+ $(OBJDIR)/lus2licRun.ml
+
+
+ln_ldbg: $(OBJDIR) $(LDBG_SOURCES)
+ldbg : ln_ldbg
+ make -f Makefile.lib4lurette ncl
+
#
# Be sure to build those files before doing something else
# since they are needed by $(RESULT)
@@ -177,10 +164,8 @@ include $(OCAMLMAKEFILE)
.PRECIOUS: $(OBJDIR)/version.ml
-
-
$(OBJDIR)/version.ml: Makefile
- echo "(** Automatically generated from Makefile *) " > $@
+ echo "(** Automatically gen erated from Makefile *) " > $@
echo "let tool = \"lus2lic\"" >> $@
echo "let branch = \"$(shell utils/get_branch_name)\"" >> $@
echo "let commit = \"$(shell utils/get_commit_number)\"" >> $@
@@ -188,17 +173,11 @@ $(OBJDIR)/version.ml: Makefile
echo "let str = (branch ^ \".\" ^ commit ^ \" (\" ^ sha_1 ^ \")\")">> $@
echo "let maintainer = \"jahier@imag.fr\"">> $@
-
-
-
-
all: nc
lus2lic:
make all
make test
-
-
# TEST, NON REGR. ETC...
TESTDIR=./test
diff --git a/Makefile.common b/Makefile.common
new file mode 100644
index 00000000..ebf79914
--- /dev/null
+++ b/Makefile.common
@@ -0,0 +1,34 @@
+
+curdir=$(shell pwd)
+
+
+OBJDIR=./obj$(HOSTTYPE)
+SRCDIR=./src
+
+LN=ln -s
+$(OBJDIR)/% : $(SRCDIR)/%
+ rm -f $@; cd $(OBJDIR) && $(LN) ../$(SRCDIR)/$* . && cd $(curdir)
+
+$(OBJDIR):
+ mkdir $(OBJDIR)
+
+OCAMLMAKEFILE = ./OCamlMakefile
+RESULT=$(OBJDIR)/lus2lic$(EXE)
+
+LIBS = str unix
+
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+
+ifeq ($(HOSTTYPE),win32)
+ OCAMLC=/usr/i586-mingw32msvc/bin/ocamlc
+ OCAMLOPT=/usr/i586-mingw32msvc/bin/ocamlopt
+ OCAMLDEP=/usr/i586-mingw32msvc/bin/ocamldep
+ OCAMLRUN=/usr/i586-mingw32msvc/bin/ocamlrun
+ OCAMLLIB = `/usr/i586-mingw32msvc/bin/ocamlc -where`
+endif
+
+ifeq ($(HOSTTYPE),cygwin)
+CFLAGS=-mno-cygwin
+endif
+
diff --git a/Makefile.lib4lurette b/Makefile.lib4lurette
new file mode 100644
index 00000000..53bb985e
--- /dev/null
+++ b/Makefile.lib4lurette
@@ -0,0 +1,7 @@
+
+include ./Makefile
+
+SOURCES = $(LDBG_SOURCES)
+
+
+all: ncl
diff --git a/src/compile.ml b/src/compile.ml
index f7a245ab..e5994d8b 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 14:41) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 09:51) by Erwan Jahier> *)
open Lxm
open Errors
@@ -7,8 +7,8 @@ open AstCore
(* get the first package in the package/model list *)
-let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
- fun srclist main_node ->
+let (doit : MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
+ fun opt srclist main_node ->
let syntax_tab = AstTab.create srclist in
(* Pour chaque package, on a un solveur de références
globales, pour les types, const et node :
@@ -26,7 +26,7 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
let lic_tab = match main_node with
| None -> LicTab.compile_all lic_tab
| Some main_node ->
- if !Global.compile_all_items then
+ if opt.MainArgs.compile_all_items then
LicTab.compile_all lic_tab
else
LicTab.compile_node lic_tab main_node
@@ -36,14 +36,14 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
let zelic = L2lRmPoly.doit zelic in
(* alias des types array *)
(* let zelic = L2lAliasType.doit zelic in *)
- let zelic = if not !Global.inline_iterator then zelic else
+ let zelic = if not opt.MainArgs.inline_iterator then zelic else
(* to be done before array expansion otherwise they won't be expanded *)
L2lExpandMetaOp.doit zelic
in
let zelic =
if
- !Global.one_op_per_equation
- || !Global.expand_nodes (* expand performs no fixpoint, so it will work
+ MainArgs.global_opt.MainArgs.one_op_per_equation
+ || opt.MainArgs.expand_nodes (* expand performs no fixpoint, so it will work
only if we have one op per equation...*)
then
(* Split des equations (1 eq = 1 op) *)
@@ -52,16 +52,143 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
zelic
in
(* Array and struct expansion: to do after polymorphism elimination *)
- let zelic = if not !Global.expand_nodes then zelic else
- L2lExpandNodes.doit zelic
+ let zelic = if not opt.MainArgs.expand_nodes then zelic else
+ L2lExpandNodes.doit opt.MainArgs.dont_expand_nodes zelic
in
- let zelic = if not !Global.expand_arrays then zelic else
+ let zelic = if not opt.MainArgs.expand_arrays then zelic else
L2lExpandArrays.doit zelic
in
(* Currently only works in this mode *)
- if !Global.ec then L2lCheckLoops.doit zelic;
+ if MainArgs.global_opt.MainArgs.ec then L2lCheckLoops.doit zelic;
L2lCheckOutputs.doit zelic;
zelic
+let test_lex ( lexbuf ) = (
+ let tk = ref (Lexer.lexer lexbuf) in
+ while !tk <> Parser.TK_EOF do
+ match (Lexer.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 := (Lexer.lexer lexbuf)
+ done
+)
+
+(* Retourne un AstV6.t *)
+let lus_load lexbuf =
+ let tree = Parser.program Lexer.lexer lexbuf in
+ LicName.update_fresh_var_prefix ();
+ (* ICI *)
+ AstRecognizePredef.f tree
+
+type maybe_packed =
+ | Packed of AstV6.pack_or_model
+ | Unpacked of AstV6.packbody
+
+let (get_source_list : MainArgs.t -> string list -> AstV6.pack_or_model list) =
+ fun opt infile_list ->
+ let (get_one_source : string -> string list * maybe_packed list) =
+ fun infile ->
+ let incl_files, l =
+ let lexbuf = MainArgs.lexbuf_of_file_name infile in
+ if opt.MainArgs.tlex then test_lex lexbuf;
+ match (lus_load lexbuf) with
+ | PRPackBody(incl_files, pbdy) -> incl_files, [Unpacked pbdy]
+ | PRPack_or_models(incl_files, nsl) -> incl_files, (List.map (fun ns -> Packed ns) nsl)
+ in
+ (* If included files have a relative path, strange things may happen.
+ Hence we make the path absolute, using the directory of the includer.
+ *)
+ let includer_dir = Filename.dirname infile in
+ let fix_dir f = if Filename.is_relative f then Filename.concat includer_dir f else f in
+ let incl_files = List.map fix_dir incl_files in
+ incl_files, l
+ in
+ let rec (get_remaining_source_list : maybe_packed list * string list * string list ->
+ maybe_packed list * string list * string list) =
+ fun (pack_acc, compiled, to_be_compiled) ->
+ match to_be_compiled with
+ | [] -> (pack_acc, compiled, [])
+ | infile::tail ->
+ let infile = FilenameExtras.simplify infile in
+ if List.mem infile compiled then
+ get_remaining_source_list (pack_acc, compiled, tail)
+ else
+ let included_files, pack = get_one_source infile in
+ let new_pack_acc = pack_acc@pack in
+ get_remaining_source_list(
+ new_pack_acc,
+ infile::compiled,
+ tail@included_files)
+ in
+ let infile_list =
+ (* We need absolute paths to make sure that files are not
+ included several times. Indeed, otherwise,
+ FilenameExtras.simplify may miss some simplifications. For
+ example, consider the files "../../x/toto.lus" and
+ "../toto.lus". They actually refer to the same file if the
+ current directory is a sub-directory of "x". Working with
+ absolute paths solves the problem.
+
+ *)
+ let make_it_absolute f =
+ if Filename.is_relative f then Filename.concat (Sys.getcwd ()) f else f
+ in
+ List.map make_it_absolute infile_list
+ in
+ let first_file = assert (infile_list <> []); List.hd infile_list in
+ let included_files, first_pack = get_one_source first_file in
+ let (pack_list, _compiled_files, included_files) =
+ get_remaining_source_list (first_pack, [first_file], (List.tl infile_list) @ included_files)
+ in
+ let _ = assert (included_files=[]) in
+ let packed_list, unpacked_list =
+ List.fold_left
+ (fun (pl, upl) p ->
+ match p with
+ | Packed p -> p::pl, upl
+ | Unpacked up -> pl, up::upl
+ )
+ ([], [])
+ pack_list
+ in
+ let unpacked_merged_opt = (* All unpacked files are merged into one single package *)
+ List.fold_left
+ (fun acc pbody ->
+ match acc with
+ | None -> Some pbody
+ | Some pbody_acc ->
+ let add tbl x y =
+ (* Let's perform some clashes checks *)
+ if Hashtbl.mem tbl x then
+ let ybis = Hashtbl.find tbl x in
+ print_string ("*** Error: "^(Ident.to_string x)^" is defined twice: \n\t" ^
+ (Lxm.details y.src) ^ "\n\t" ^
+ (Lxm.details ybis.src) ^ ".\n");
+ exit 2
+ else
+ Hashtbl.add tbl x y
+ in
+ Hashtbl.iter (fun x y -> add pbody_acc.pk_const_table x y) pbody.pk_const_table;
+ Hashtbl.iter (fun x y -> add pbody_acc.pk_type_table x y) pbody.pk_type_table;
+ Hashtbl.iter (fun x y -> add pbody_acc.pk_node_table x y) pbody.pk_node_table;
+ Some { pbody_acc with
+ pk_def_list=pbody_acc.pk_def_list@pbody.pk_def_list;
+ }
+ )
+ None
+ unpacked_list
+ in
+ match unpacked_merged_opt with
+ | None -> packed_list
+ | Some unpacked_merged ->
+ let name =
+ try Filename.chop_extension (Filename.basename first_file)
+ with _ ->
+ print_string ("*** '"^first_file^"': bad file name.\n"); exit 1
+ in
+ let pi = AstV6.give_pack_this_name (Ident.pack_name_of_string name) unpacked_merged in
+ let p = NSPack (Lxm.flagit pi (Lxm.dummy name)) in
+ p::packed_list
diff --git a/src/compile.mli b/src/compile.mli
index 96a7bc14..1c744fd0 100644
--- a/src/compile.mli
+++ b/src/compile.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 01/02/2013 (at 17:29) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 09:51) by Erwan Jahier> *)
(** Main bis *)
@@ -6,5 +6,7 @@
main node. *)
-val doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t
-val if !Global.ec then L2lCheckLoops.doit zelic;
+val doit : MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t
+
+
+val get_source_list : MainArgs.t -> string list -> AstV6.pack_or_model list
diff --git a/src/event.ml b/src/event.ml
new file mode 120000
index 00000000..1c18f000
--- /dev/null
+++ b/src/event.ml
@@ -0,0 +1 @@
+/home/jahier/lurette/source/Lurettetop/event.ml
\ No newline at end of file
diff --git a/src/expr.ml b/src/expr.ml
new file mode 120000
index 00000000..bda437aa
--- /dev/null
+++ b/src/expr.ml
@@ -0,0 +1 @@
+/home/jahier/lurette/source/Lurettetop/expr.ml
\ No newline at end of file
diff --git a/src/failure.ml b/src/failure.ml
new file mode 100644
index 00000000..cd2160ab
--- /dev/null
+++ b/src/failure.ml
@@ -0,0 +1,3 @@
+
+(* stub *)
+type info = string
diff --git a/src/global.ml b/src/global.ml
deleted file mode 100644
index 28961537..00000000
--- a/src/global.ml
+++ /dev/null
@@ -1,52 +0,0 @@
-(* Time-stamp: <modified the 14/03/2013 (at 17:17) by Erwan Jahier> *)
-
-(** Global variables for handling command-line options. *)
-
-
-(** flag 'paranoid' utile pour forcer (via le mecanisme Verbose.exe)
- des vérifs de trucs douteux ...
-*)
-let paranoid = Some (Verbose.get_flag "paranoid")
-
-(** to compute line/col *)
-let line_num = ref 1
-let line_start_pos = ref 0
-let (outfile:string ref) = ref ""
-let (infiles:string list ref) = ref []
-let current_file = ref ""
-let main_node = ref ""
-let compile_all_items = ref true
-let run_unit_test = ref false
-let one_op_per_equation = ref true
-let inline_iterator = ref false
-let lv4 = ref false
-let ec = ref false
-let no_prefix = ref false
-let expand_nodes = ref false
-let dont_expand_nodes : string list ref = ref []
-let expand_enums = ref false
-let expand_arrays = ref false
-(** the output channel *)
-let oc = ref Pervasives.stdout
-let tlex = ref false
-let nonreg_test = ref false
-let exec = ref false
-
-(** those functions are here as they modify some global vars *)
-let add_infile file_name =
- infiles := !infiles@[file_name]
-
-
-let lexbuf_of_file_name file =
- let inchannel =
- Verbose.print_string ~level:1
-(* ("Opening file " ^ (Filename.concat (Sys.getcwd ()) file) ^ "\n"); *)
- ("Opening file " ^ (file) ^ "\n");
- open_in file
- in
- line_num := 1;
- line_start_pos := 0;
- current_file := file;
- Lexing.from_channel inchannel
-
-
diff --git a/src/ident.ml b/src/ident.ml
index 3080710e..53121504 100644
--- a/src/ident.ml
+++ b/src/ident.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 15:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 17:18) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
@@ -69,7 +69,7 @@ let (pack_name_to_string : pack_name -> string) =
let (string_of_long : long -> string) =
fun (pn, id) ->
let sep =
- if !Global.ec || !Global.lv4 then "__" else "::"
+ if MainArgs.global_opt.MainArgs.ec || MainArgs.global_opt.MainArgs.lv4 then "__" else "::"
in
match pn with
| "" -> id
@@ -135,9 +135,9 @@ let (long_of_string : string -> long) =
let string_of_idref i = (
match i.id_pack with
Some p ->
- if !Global.no_prefix then i.id_id else
- if !Global.ec then p^"__"^i.id_id else
- if !Global.lv4 then (p^"__"^i.id_id) else
+ if MainArgs.global_opt.MainArgs.no_prefix then i.id_id else
+ if MainArgs.global_opt.MainArgs.ec then p^"__"^i.id_id else
+ if MainArgs.global_opt.MainArgs.lv4 then (p^"__"^i.id_id) else
(p^"::"^i.id_id)
| None -> i.id_id
)
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index 2c480236..7d7a595d 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/03/2013 (at 18:38) by Erwan Jahier> *)
+(** Time-stamp: <modified the 09/04/2013 (at 17:35) 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...
@@ -343,7 +343,7 @@ 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 ->
- if not !Global.ec then
+ if not MainArgs.global_opt.MainArgs.ec then
[{ src = lxm ; it = (left_list, ve) }]
else
(* we only need to break tuples in this mode ...
diff --git a/src/l2lExpandNodes.ml b/src/l2lExpandNodes.ml
index ca799135..07f3d623 100644
--- a/src/l2lExpandNodes.ml
+++ b/src/l2lExpandNodes.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 02/04/2013 (at 11:12) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 16:45) by Erwan Jahier> *)
open Lxm
@@ -12,6 +12,7 @@ type local_ctx = {
idgen : LicPrg.id_generator;
node : Lic.node_exp;
prg : LicPrg.t;
+ nodes : string list; (* nodes to repserve from expansion *)
}
(********************************************************************************)
@@ -205,7 +206,7 @@ and (expand_eq_aux: local_ctx -> Lic.eq_info -> acc option)=
in
if
let nname = Ident.string_of_long2 (fst node.it.node_key_eff) in
- (List.mem nname !Global.dont_expand_nodes)
+ (List.mem nname lctx.nodes)
then
None
else
@@ -276,8 +277,8 @@ let (node : local_ctx -> Lic.node_exp -> Lic.node_exp) =
| MetaOpLic -> n
(* exported *)
-let (doit : LicPrg.t -> LicPrg.t) =
- fun inprg ->
+let (doit : string list -> LicPrg.t -> LicPrg.t) =
+ fun nodes inprg ->
let outprg = LicPrg.empty in
(** types and constants do not change *)
let outprg = LicPrg.fold_types LicPrg.add_type inprg outprg in
@@ -292,6 +293,7 @@ let (doit : LicPrg.t -> LicPrg.t) =
idgen = LicPrg.fresh_var_id_generator inprg ne;
node = ne;
prg = inprg;
+ nodes = nodes;
}
in
let ne = node lctx ne in
diff --git a/src/l2lExpandNodes.mli b/src/l2lExpandNodes.mli
index 8b0558db..1a504860 100644
--- a/src/l2lExpandNodes.mli
+++ b/src/l2lExpandNodes.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/12/2012 (at 15:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 16:42) by Erwan Jahier> *)
(** Expand user nodes
@@ -74,5 +74,7 @@
I could remove that restriction by adding a fixpoint somewhere,
but is it worth bothering ?
+
+ the first arf is the list of node to not expand
*)
-val doit : LicPrg.t -> LicPrg.t
+val doit : string list -> LicPrg.t -> LicPrg.t
diff --git a/src/lic.ml b/src/lic.ml
index f19acc95..0d95e7f0 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 04/04/2013 (at 16:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 17:25) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -469,13 +469,13 @@ let rec subst_matches (matches: type_matches) (t: type_) : type_ =
on utilse paranoid au cas où ...
*)
| Abstract_type_eff(l,td) ->
- Verbose.exe ~flag:Global.paranoid ( fun () ->
+ Verbose.exe ~flag:MainArgs.paranoid ( fun () ->
let t' = Abstract_type_eff(l,subst_matches matches td) in
if t <> t' then assert false
);
t
| Struct_type_eff(l,fl) ->
- Verbose.exe ~flag:Global.paranoid ( fun () ->
+ Verbose.exe ~flag:MainArgs.paranoid ( fun () ->
let t' = Struct_type_eff(
l, List.map (fun (id,(teff,copt)) -> (id,(subst_matches matches teff, copt))) fl)
in
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index cf5fa775..b6cecd38 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 08/04/2013 (at 14:25) by Erwan Jahier> *)
+(** Time-stamp: <modified the 09/04/2013 (at 17:34) by Erwan Jahier> *)
open Lxm
open Lic
@@ -673,7 +673,6 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
assert false
);
let soc_tbl = SocMap.add soc.key soc soc_tbl in
- let t = List.hd types in
snd (process_node nk soc_tbl)
)
| Undef_merge_soc (sk, lxm, clk, case_l) -> (
diff --git a/src/licDump.ml b/src/licDump.ml
index 7dac4aca..af753fd2 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,14 +1,15 @@
-(* Time-stamp: <modified the 04/04/2013 (at 11:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 17:26) by Erwan Jahier> *)
open Errors
open Printf
open Lxm
open Lic
open List
+open MainArgs
(* XXX changer le nom de cette fonction *)
let (dump_long : Ident.long -> string) = fun x ->
- if !Global.no_prefix then
+ if global_opt.no_prefix then
Ident.no_pack_string_of_long x
else
Ident.string_of_long x
@@ -40,7 +41,7 @@ let rec is_a_tuple (e:Lic.val_exp) : bool =
(******************************************************************************)
let string_of_ident x =
- if !Global.no_prefix
+ if global_opt.no_prefix
then Ident.no_pack_string_of_long x
else Ident.string_of_long2 x
@@ -296,7 +297,7 @@ and string_of_decl var_info_eff =
(string_of_type_eff var_info_eff.var_type_eff)
in
let clk_str = (string_of_clock (snd var_info_eff.var_clock_eff)) in
- if !Global.ec then vt_str else vt_str ^ clk_str
+ if global_opt.ec then vt_str else vt_str ^ clk_str
and (string_of_type_decl_list : Lic.var_info list -> string -> string) =
fun tel sep ->
@@ -343,7 +344,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| CALL ({it=("Lustre","diese"),[]}), [ve1]
| PREDEF_CALL ({it=("Lustre","diese"),[]}), [ve1] ->
- if !Global.lv4 && array_of_size_one ve1
+ if global_opt.lv4 && array_of_size_one ve1
then sov ve1 (* lv4 does no accept to apply # on One var only! *)
else
(("#") ^ (tuple_par [ve1]))
@@ -382,7 +383,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
)
else
let nk = op.it in
- if !Global.lv4 then
+ if global_opt.lv4 then
((string_of_node_key nk) ^ (tuple_par vel))
else
((string_of_node_key_rec nk) ^ (tuple_par vel))
@@ -395,7 +396,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
" -> " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
| FBY, [ve1; ve2] ->
- if !Global.lv4 then
+ if global_opt.lv4 then
(if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
^ " -> pre " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
@@ -447,7 +448,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
(* ident or predef constants *)
(do_not_parenthesize (posop.it,vel))
||
- !Global.one_op_per_equation
+ global_opt.one_op_per_equation
then
str
else
@@ -463,7 +464,7 @@ and string_of_val_exp_eff_core ve_core =
| Merge (ve, [({it=Bool_const_eff true }, ct); ({it=Bool_const_eff false}, cf)])
| Merge (ve, [({it=Bool_const_eff false}, cf); ({it=Bool_const_eff true}, ct)]) ->
- if !Global.lv4 then (
+ if global_opt.lv4 then (
"if " ^ (string_of_val_exp_eff ve) ^ " then current (" ^
(string_of_val_exp_eff ct) ^ ") else current (" ^
(string_of_val_exp_eff cf) ^")"
@@ -581,7 +582,7 @@ and (const_decl: Ident.long -> Lic.const -> string) =
| Extern_const_eff _
| Abstract_const_eff _ ->
begin_str ^ " : " ^ (string_of_type_eff (Lic.type_of_const ceff)) ^
- (* (if !Global.ec then ".\n" else *)
+ (* (if global_opt.ec then ".\n" else *)
(";\n")
| Struct_const_eff _
| Array_const_eff _
@@ -601,11 +602,11 @@ and node_of_node_exp_eff
wrap_long_profile (
(
- if neff.def_eff = ExternLic && not (!Global.lv4)
+ if neff.def_eff = ExternLic && not (global_opt.lv4)
(* no extern kwd in v4... *)
then "extern " else ""
)^(
- if !Global.lv4 then (
+ if global_opt.lv4 then (
(* node and function does not have the same meaning in v4... *)
if neff.def_eff = ExternLic then "function " else "node "
) else (
@@ -657,7 +658,7 @@ and (string_of_ident_clk : Ident.clk -> string) =
| "Lustre","true" -> (Ident.to_string v)
| "Lustre","false" -> "not " ^ (Ident.to_string v)
| _ ->
-(* if !Global.lv4 then *)
+(* if global_opt.lv4 then *)
(* raise (Errors.Global_error *)
(* ("*** Cannot generate V4 style Lustre for programs with enumerated "^ *)
(* "clocks (yet), sorry.")) *)
@@ -691,7 +692,7 @@ and string_of_clock (ck : Lic.clock) =
and op2string op =
(* Une verrue pour compatible avec les outils qui mangent du ec... *)
- if !Global.ec && op = AstPredef.INT2REAL_n then "real" else
+ if global_opt.ec && op = AstPredef.INT2REAL_n then "real" else
AstPredef.op2string op
(*---------------------------------------------------------------------
diff --git a/src/licPrg.ml b/src/licPrg.ml
index 6bdf2d81..22b5644a 100644
--- a/src/licPrg.ml
+++ b/src/licPrg.ml
@@ -115,14 +115,14 @@ let add_node (k:Lic.node_key) (v:Lic.node_exp) (prg:t) : t =
{ prg with nodes = NodeKeyMap.add k v prg.nodes }
exception Print_me of Lic.node_exp
-let to_file (oc: out_channel) (this:t) (main_node: Ident.idref option) =
- Verbose.dump_entete oc;
+let to_file (opt: MainArgs.t) (this:t) (main_node: Ident.idref option) =
+ Verbose.dump_entete opt.MainArgs.oc;
(* On imprime dans l'ordre du iter, donc pas terrible ???
*)
ItemKeyMap.iter
(fun tn te ->
- if (not !Global.ec || Lic.is_extern_type te) then
- output_string !Global.oc (LicDump.type_decl tn te)
+ if (not MainArgs.global_opt.MainArgs.ec || Lic.is_extern_type te) then
+ output_string opt.MainArgs.oc (LicDump.type_decl tn te)
)
this.types;
@@ -146,13 +146,13 @@ let to_file (oc: out_channel) (this:t) (main_node: Ident.idref option) =
const white:color1;
*)
- if !Global.expand_enums then (
+ if opt.MainArgs.expand_enums then (
let const_list =
ItemKeyMap.fold
(fun tn te acc ->
match te with
| Lic.Enum_type_eff(long, longl) ->
- output_string !Global.oc (LicDump.type_decl long (Lic.External_type_eff long));
+ output_string opt.MainArgs.oc (LicDump.type_decl long (Lic.External_type_eff long));
List.rev_append (List.map (fun x -> long,x) longl) acc
| _ -> acc
)
@@ -162,16 +162,16 @@ let to_file (oc: out_channel) (this:t) (main_node: Ident.idref option) =
List.iter
(fun (t,elt) ->
let const = Lic.Extern_const_eff (elt, Lic.External_type_eff t) in
- output_string !Global.oc (LicDump.const_decl elt const))
+ output_string opt.MainArgs.oc (LicDump.const_decl elt const))
const_list;
);
ItemKeyMap.iter
(fun cn ce ->
- if (not !Global.ec || Lic.is_extern_const ce) then
- output_string !Global.oc (LicDump.const_decl cn ce)
+ if (not MainArgs.global_opt.MainArgs.ec || Lic.is_extern_const ce) then
+ output_string opt.MainArgs.oc (LicDump.const_decl cn ce)
)
this.consts ;
- if !Global.ec then (
+ if MainArgs.global_opt.MainArgs.ec then (
(* If no node is set a top-level, the compiler will compile every node. But the
ec format only accepts one node (and no type nor const)
Hence we print the first one (if no main node is set).
@@ -192,16 +192,16 @@ let to_file (oc: out_channel) (this:t) (main_node: Ident.idref option) =
| (("Lustre",_),[]), Lic.ExternLic -> ()
| _, Lic.ExternLic ->
(* we need to declare all extern nodes (do we?) *)
- output_string !Global.oc (LicDump.node_of_node_exp_eff nexp);
- flush !Global.oc;
+ output_string opt.MainArgs.oc (LicDump.node_of_node_exp_eff nexp);
+ flush opt.MainArgs.oc;
| _ -> ()
)
)
)
this.nodes
with Print_me nexp ->
- output_string !Global.oc (LicDump.node_of_node_exp_eff nexp);
- flush !Global.oc;
+ output_string opt.MainArgs.oc (LicDump.node_of_node_exp_eff nexp);
+ flush opt.MainArgs.oc;
) else (
(* Pour les noeuds, pas sur que ça marche tant qu'on n'a
pas séparés les transformations source_to_source du LicTab:
@@ -218,7 +218,7 @@ let to_file (oc: out_channel) (this:t) (main_node: Ident.idref option) =
match nexp.Lic.node_key_eff with
(* inutile d'écrire les noeuds predefs *)
| (("Lustre",_),[]) -> ()
- | _ -> output_string !Global.oc (LicDump.node_of_node_exp_eff nexp)
+ | _ -> output_string opt.MainArgs.oc (LicDump.node_of_node_exp_eff nexp)
)
this.nodes
)
diff --git a/src/licPrg.mli b/src/licPrg.mli
index bfdfdfef..a07a3edf 100644
--- a/src/licPrg.mli
+++ b/src/licPrg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 18/03/2013 (at 17:30) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 17:33) by Erwan Jahier> *)
(** The data structure resulting from the compilation process *)
@@ -44,7 +44,7 @@ val iter_consts : (Lic.item_key -> Lic.const -> unit) -> t -> unit
val iter_types : (Lic.item_key -> Lic.type_ -> unit) -> t -> unit
val iter_nodes : (Lic.node_key -> Lic.node_exp -> unit) -> t -> unit
-val to_file : out_channel -> t -> Ident.idref option -> unit
+val to_file : MainArgs.t -> t -> Ident.idref option -> unit
val find_type : t -> Lic.item_key -> Lic.type_ option
val find_const : t -> Lic.item_key -> Lic.const option
diff --git a/src/lpp-dot.ps b/src/lpp-dot.ps
deleted file mode 100644
index 11e3e9a1..00000000
--- a/src/lpp-dot.ps
+++ /dev/null
@@ -1,1304 +0,0 @@
-%!PS-Adobe-2.0
-%%Creator: dot version 2.8 (Fri Nov 17 20:26:27 UTC 2006)
-%%For: (jahier) Erwan Jahier
-%%Title: G
-%%Pages: (atend)
-%%BoundingBox: 36 36 764 584
-%%EndComments
-save
-%%BeginProlog
-/DotDict 200 dict def
-DotDict begin
-
-/setupLatin1 {
-mark
-/EncodingVector 256 array def
- EncodingVector 0
-
-ISOLatin1Encoding 0 255 getinterval putinterval
-EncodingVector 45 /hyphen put
-
-% Set up ISO Latin 1 character encoding
-/starnetISO {
- dup dup findfont dup length dict begin
- { 1 index /FID ne { def }{ pop pop } ifelse
- } forall
- /Encoding EncodingVector def
- currentdict end definefont
-} def
-/Times-Roman starnetISO def
-/Times-Italic starnetISO def
-/Times-Bold starnetISO def
-/Times-BoldItalic starnetISO def
-/Helvetica starnetISO def
-/Helvetica-Oblique starnetISO def
-/Helvetica-Bold starnetISO def
-/Helvetica-BoldOblique starnetISO def
-/Courier starnetISO def
-/Courier-Oblique starnetISO def
-/Courier-Bold starnetISO def
-/Courier-BoldOblique starnetISO def
-cleartomark
-} bind def
-
-%%BeginResource: procset graphviz 0 0
-/coord-font-family /Times-Roman def
-/default-font-family /Times-Roman def
-/coordfont coord-font-family findfont 8 scalefont def
-
-/InvScaleFactor 1.0 def
-/set_scale {
- dup 1 exch div /InvScaleFactor exch def
- dup scale
-} bind def
-
-% styles
-/solid { [] 0 setdash } bind def
-/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
-/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
-/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
-/bold { 2 setlinewidth } bind def
-/filled { } bind def
-/unfilled { } bind def
-/rounded { } bind def
-/diagonals { } bind def
-
-% hooks for setting color
-/nodecolor { sethsbcolor } bind def
-/edgecolor { sethsbcolor } bind def
-/graphcolor { sethsbcolor } bind def
-/nopcolor {pop pop pop} bind def
-
-/beginpage { % i j npages
- /npages exch def
- /j exch def
- /i exch def
- /str 10 string def
- npages 1 gt {
- gsave
- coordfont setfont
- 0 0 moveto
- (\() show i str cvs show (,) show j str cvs show (\)) show
- grestore
- } if
-} bind def
-
-/set_font {
- findfont exch
- scalefont setfont
-} def
-
-% draw aligned label in bounding box aligned to current point
-/alignedtext { % width adj text
- /text exch def
- /adj exch def
- /width exch def
- gsave
- width 0 gt {
- text stringwidth pop adj mul 0 rmoveto
- } if
- [] 0 setdash
- text show
- grestore
-} def
-
-/boxprim { % xcorner ycorner xsize ysize
- 4 2 roll
- moveto
- 2 copy
- exch 0 rlineto
- 0 exch rlineto
- pop neg 0 rlineto
- closepath
-} bind def
-
-/ellipse_path {
- /ry exch def
- /rx exch def
- /y exch def
- /x exch def
- matrix currentmatrix
- newpath
- x y translate
- rx ry scale
- 0 0 1 0 360 arc
- setmatrix
-} bind def
-
-/endpage { showpage } bind def
-/showpage { } def
-
-/layercolorseq
- [ % layer color sequence - darkest to lightest
- [0 0 0]
- [.2 .8 .8]
- [.4 .8 .8]
- [.6 .8 .8]
- [.8 .8 .8]
- ]
-def
-
-/layerlen layercolorseq length def
-
-/setlayer {/maxlayer exch def /curlayer exch def
- layercolorseq curlayer 1 sub layerlen mod get
- aload pop sethsbcolor
- /nodecolor {nopcolor} def
- /edgecolor {nopcolor} def
- /graphcolor {nopcolor} def
-} bind def
-
-/onlayer { curlayer ne {invis} if } def
-
-/onlayers {
- /myupper exch def
- /mylower exch def
- curlayer mylower lt
- curlayer myupper gt
- or
- {invis} if
-} def
-
-/curlayer 0 def
-
-%%EndResource
-%%EndProlog
-%%BeginSetup
-14 default-font-family set_font
-1 setmiterlimit
-% /arrowlength 10 def
-% /arrowwidth 5 def
-
-% make sure pdfmark is harmless for PS-interpreters other than Distiller
-/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
-% make '<<' and '>>' safe on PS Level 1 devices
-/languagelevel where {pop languagelevel}{1} ifelse
-2 lt {
- userdict (<<) cvn ([) cvn load put
- userdict (>>) cvn ([) cvn load put
-} if
-
-%%EndSetup
-%%Page: 1 1
-%%PageBoundingBox: 36 36 584 764
-%%PageOrientation: Landscape
-gsave
-36 36 548 728 boxprim clip newpath
-36 36 translate
-gsave 728 0 translate 90 rotate
-0 0 1 beginpage
-grestore
-0.4508 set_scale
-1207 9 translate 90 rotate
-0.000 0.000 1.000 graphcolor
-0.000 0.000 1.000 graphcolor
-newpath -13 -13 moveto
--13 1211 lineto
-1610 1211 lineto
-1610 -13 lineto
-closepath
-fill
-0.000 0.000 1.000 graphcolor
-newpath -13 -13 moveto
--13 1211 lineto
-1610 1211 lineto
-1610 -13 lineto
-closepath
-stroke
-0.000 0.000 0.000 graphcolor
-14.00 /Times-Roman set_font
-% Main
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-640 489 28 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-624 484 moveto
-(Main)
-[12.48 6.24 3.84 6.96]
-xshow
-end grestore
-end grestore
-% Version
-gsave 10 dict begin
-200 272 36 18 ellipse_path
-stroke
-gsave 10 dict begin
-177 267 moveto
-(Version)
-[10.08 6.24 4.56 5.52 3.84 6.96 6.96]
-xshow
-end grestore
-end grestore
-% Main->Version
-newpath 618 478 moveto
-546 442 322 332 235 290 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 236 287 moveto
-226 285 lineto
-233 293 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 236 287 moveto
-226 285 lineto
-233 293 lineto
-closepath
-stroke
-end grestore
-% Verbose
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-291 272 37 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-267 267 moveto
-(Verbose)
-[10.08 6.24 4.56 6.96 6.96 5.52 6.24]
-xshow
-end grestore
-end grestore
-% Main->Verbose
-newpath 620 476 moveto
-562 440 393 335 323 292 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 324 289 moveto
-314 286 lineto
-320 294 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 324 289 moveto
-314 286 lineto
-320 294 lineto
-closepath
-stroke
-end grestore
-% Syntaxe
-gsave 10 dict begin
-1343 272 36 18 ellipse_path
-stroke
-gsave 10 dict begin
-1320 267 moveto
-(Syntaxe)
-[7.68 6.96 6.96 3.84 6.24 6.96 6.24]
-xshow
-end grestore
-end grestore
-% Main->Syntaxe
-newpath 665 481 moveto
-770 449 1173 325 1302 284 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1303 287 moveto
-1312 281 lineto
-1301 281 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1303 287 moveto
-1312 281 lineto
-1301 281 lineto
-closepath
-stroke
-end grestore
-% Printf
-gsave 10 dict begin
-375 272 29 18 ellipse_path
-stroke
-gsave 10 dict begin
-359 267 moveto
-(Printf)
-[7.68 4.56 3.84 6.96 3.84 4.56]
-xshow
-end grestore
-end grestore
-% Main->Printf
-newpath 623 475 moveto
-577 437 454 337 401 293 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 403 290 moveto
-393 287 lineto
-399 296 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 403 290 moveto
-393 287 lineto
-399 296 lineto
-closepath
-stroke
-end grestore
-% Parsing
-gsave 10 dict begin
-456 272 34 18 ellipse_path
-stroke
-gsave 10 dict begin
-435 267 moveto
-(Parsing)
-[7.68 6.24 4.56 5.52 3.84 6.96 6.96]
-xshow
-end grestore
-end grestore
-% Main->Parsing
-newpath 626 473 moveto
-595 435 514 341 477 297 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 479 294 moveto
-470 289 lineto
-474 299 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 479 294 moveto
-470 289 lineto
-474 299 lineto
-closepath
-stroke
-end grestore
-% Parser
-gsave 10 dict begin
-538 272 30 18 ellipse_path
-stroke
-gsave 10 dict begin
-520 267 moveto
-(Parser)
-[7.68 6.24 4.56 5.52 6.24 4.56]
-xshow
-end grestore
-end grestore
-% Main->Parser
-newpath 632 472 moveto
-614 434 571 344 550 298 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 553 297 moveto
-546 289 lineto
-547 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 553 297 moveto
-546 289 lineto
-547 300 lineto
-closepath
-stroke
-end grestore
-% Lxm
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1137 272 27 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1123 267 moveto
-(Lxm)
-[8.64 6.96 10.8]
-xshow
-end grestore
-end grestore
-% Main->Lxm
-newpath 664 479 moveto
-732 451 936 367 1101 290 curveto
-1103 289 1104 289 1106 288 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1108 291 moveto
-1115 283 lineto
-1105 285 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1108 291 moveto
-1115 283 lineto
-1105 285 lineto
-closepath
-stroke
-end grestore
-% List
-gsave 10 dict begin
-613 272 27 18 ellipse_path
-stroke
-gsave 10 dict begin
-602 267 moveto
-(List)
-[8.64 3.84 5.52 3.84]
-xshow
-end grestore
-end grestore
-% Main->List
-newpath 638 471 moveto
-633 433 622 345 616 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 619 300 moveto
-615 290 lineto
-613 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 619 300 moveto
-615 290 lineto
-613 300 lineto
-closepath
-stroke
-end grestore
-% Lexing
-gsave 10 dict begin
-902 54 33 18 ellipse_path
-stroke
-gsave 10 dict begin
-882 49 moveto
-(Lexing)
-[8.64 6.24 6.96 3.84 6.96 6.96]
-xshow
-end grestore
-end grestore
-% Main->Lexing
-newpath 640 471 moveto
-641 429 647 326 687 254 curveto
-733 172 824 104 872 73 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 873 76 moveto
-880 68 lineto
-870 70 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 873 76 moveto
-880 68 lineto
-870 70 lineto
-closepath
-stroke
-end grestore
-% Lexer
-gsave 10 dict begin
-725 272 29 18 ellipse_path
-stroke
-gsave 10 dict begin
-708 267 moveto
-(Lexer)
-[8.64 6.24 6.96 6.24 4.56]
-xshow
-end grestore
-end grestore
-% Main->Lexer
-newpath 647 471 moveto
-662 433 696 344 714 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 718 301 moveto
-718 290 lineto
-711 298 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 718 301 moveto
-718 290 lineto
-711 298 lineto
-closepath
-stroke
-end grestore
-% Format
-gsave 10 dict begin
-805 272 33 18 ellipse_path
-stroke
-gsave 10 dict begin
-784 267 moveto
-(Format)
-[7.68 6.96 4.56 10.8 6.24 3.84]
-xshow
-end grestore
-end grestore
-% Main->Format
-newpath 652 473 moveto
-681 434 752 341 786 297 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 789 299 moveto
-792 289 lineto
-783 295 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 789 299 moveto
-792 289 lineto
-783 295 lineto
-closepath
-stroke
-end grestore
-% Filename
-gsave 10 dict begin
-895 272 39 18 ellipse_path
-stroke
-gsave 10 dict begin
-869 267 moveto
-(Filename)
-[7.68 3.84 3.84 6.24 6.96 6.24 10.8 6.24]
-xshow
-end grestore
-end grestore
-% Main->Filename
-newpath 657 474 moveto
-701 437 816 340 868 295 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 871 297 moveto
-876 288 lineto
-866 292 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 871 297 moveto
-876 288 lineto
-866 292 lineto
-closepath
-stroke
-end grestore
-% Errors
-gsave 10 dict begin
-982 272 30 18 ellipse_path
-stroke
-gsave 10 dict begin
-964 267 moveto
-(Errors)
-[8.64 4.56 4.56 6.96 4.56 5.52]
-xshow
-end grestore
-end grestore
-% Main->Errors
-newpath 660 476 moveto
-718 439 885 334 953 290 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 954 293 moveto
-961 285 lineto
-951 287 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 954 293 moveto
-961 285 lineto
-951 287 lineto
-closepath
-stroke
-end grestore
-% Dump
-gsave 10 dict begin
-1061 272 31 18 ellipse_path
-stroke
-gsave 10 dict begin
-1043 267 moveto
-(Dump)
-[10.08 6.96 10.8 6.96]
-xshow
-end grestore
-end grestore
-% Main->Dump
-newpath 662 478 moveto
-732 441 946 331 1029 289 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1031 292 moveto
-1038 284 lineto
-1028 286 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1031 292 moveto
-1038 284 lineto
-1028 286 lineto
-closepath
-stroke
-end grestore
-% Compile
-gsave 10 dict begin
-37 272 37 18 ellipse_path
-stroke
-gsave 10 dict begin
-12 267 moveto
-(Compile)
-[9.36 6.96 10.8 6.96 3.84 3.84 6.24]
-xshow
-end grestore
-end grestore
-% Main->Compile
-newpath 615 480 moveto
-537 453 288 366 83 290 curveto
-81 289 78 288 75 287 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 77 284 moveto
-66 283 lineto
-74 290 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 77 284 moveto
-66 283 lineto
-74 290 lineto
-closepath
-stroke
-end grestore
-% Arg
-gsave 10 dict begin
-119 272 27 18 ellipse_path
-stroke
-gsave 10 dict begin
-107 267 moveto
-(Arg)
-[10.08 4.56 6.96]
-xshow
-end grestore
-end grestore
-% Main->Arg
-newpath 616 480 moveto
-545 452 330 369 155 290 curveto
-153 289 152 289 150 288 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 151 285 moveto
-141 283 lineto
-148 291 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 151 285 moveto
-141 283 lineto
-148 291 lineto
-closepath
-stroke
-end grestore
-% Lxm->Lexing
-newpath 1121 257 moveto
-1081 220 975 121 927 77 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 929 74 moveto
-919 70 lineto
-924 79 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 929 74 moveto
-919 70 lineto
-924 79 lineto
-closepath
-stroke
-end grestore
-% CompUtils
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1239 489 44 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1208 484 moveto
-(CompUtils)
-[9.36 6.96 10.8 6.96 10.08 3.84 3.84 3.84 5.52]
-xshow
-end grestore
-end grestore
-% CompUtils->Syntaxe
-newpath 1248 471 moveto
-1266 433 1308 344 1330 299 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1333 301 moveto
-1334 290 lineto
-1327 298 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1333 301 moveto
-1334 290 lineto
-1327 298 lineto
-closepath
-stroke
-end grestore
-% CompUtils->Lxm
-newpath 1231 471 moveto
-1212 433 1170 343 1149 298 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1152 297 moveto
-1145 289 lineto
-1146 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1152 297 moveto
-1145 289 lineto
-1146 300 lineto
-closepath
-stroke
-end grestore
-% Hashtbl
-gsave 10 dict begin
-1232 272 35 18 ellipse_path
-stroke
-gsave 10 dict begin
-1209 267 moveto
-(Hashtbl)
-[10.08 6.24 5.52 6.96 3.84 6.96 3.84]
-xshow
-end grestore
-end grestore
-% CompUtils->Hashtbl
-newpath 1238 471 moveto
-1237 433 1234 345 1233 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1237 300 moveto
-1233 290 lineto
-1230 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1237 300 moveto
-1233 290 lineto
-1230 300 lineto
-closepath
-stroke
-end grestore
-% ExpandPack
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1129 489 48 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1094 484 moveto
-(ExpandPack)
-[8.64 6.96 6.96 6.24 6.96 6.96 7.68 6.24 6.24 6.96]
-xshow
-end grestore
-end grestore
-% ExpandPack->Syntaxe
-newpath 1146 472 moveto
-1184 433 1276 339 1320 295 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1322 298 moveto
-1327 288 lineto
-1317 293 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1322 298 moveto
-1327 288 lineto
-1317 293 lineto
-closepath
-stroke
-end grestore
-% ExpandPack->Lxm
-newpath 1130 471 moveto
-1132 433 1135 345 1136 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1140 300 moveto
-1136 290 lineto
-1133 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1140 300 moveto
-1136 290 lineto
-1133 300 lineto
-closepath
-stroke
-end grestore
-% ExpandPack->Hashtbl
-newpath 1137 471 moveto
-1156 433 1198 343 1220 299 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1223 301 moveto
-1224 290 lineto
-1217 298 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1223 301 moveto
-1224 290 lineto
-1217 298 lineto
-closepath
-stroke
-end grestore
-% SymbolTab
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1313 707 46 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1280 702 moveto
-(SymbolTab)
-[7.68 6.96 10.8 6.96 6.96 3.84 8.64 6.24 6.96]
-xshow
-end grestore
-end grestore
-% SymbolTab->Syntaxe
-newpath 1323 689 moveto
-1341 655 1380 578 1394 507 curveto
-1409 431 1375 343 1356 299 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1359 298 moveto
-1352 290 lineto
-1353 301 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1359 298 moveto
-1352 290 lineto
-1353 301 lineto
-closepath
-stroke
-end grestore
-% SymbolTab->Lxm
-newpath 1283 693 moveto
-1229 666 1117 601 1072 507 curveto
-1038 434 1090 340 1119 296 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1122 298 moveto
-1125 288 lineto
-1116 294 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1122 298 moveto
-1125 288 lineto
-1116 294 lineto
-closepath
-stroke
-end grestore
-% SymbolTab->CompUtils
-newpath 1307 689 moveto
-1294 650 1264 562 1248 516 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1251 515 moveto
-1245 507 lineto
-1245 518 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1251 515 moveto
-1245 507 lineto
-1245 518 lineto
-closepath
-stroke
-end grestore
-% SrcTab
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1313 925 33 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1292 920 moveto
-(SrcTab)
-[7.68 4.56 6.24 8.64 6.24 6.96]
-xshow
-end grestore
-end grestore
-% SrcTab->Syntaxe
-newpath 1322 907 moveto
-1351 847 1440 642 1411 471 curveto
-1401 407 1372 337 1355 299 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1358 298 moveto
-1351 290 lineto
-1352 301 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1358 298 moveto
-1351 290 lineto
-1352 301 lineto
-closepath
-stroke
-end grestore
-% SrcTab->SymbolTab
-newpath 1313 907 moveto
-1313 868 1313 780 1313 735 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1317 735 moveto
-1313 725 lineto
-1310 735 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1317 735 moveto
-1313 725 lineto
-1310 735 lineto
-closepath
-stroke
-end grestore
-% EvalConst
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1343 489 42 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1313 484 moveto
-(EvalConst)
-[8.64 6.96 6.24 3.84 9.36 6.96 6.96 5.52 3.84]
-xshow
-end grestore
-end grestore
-% EvalConst->Syntaxe
-newpath 1343 471 moveto
-1343 433 1343 345 1343 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1347 300 moveto
-1343 290 lineto
-1340 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1347 300 moveto
-1343 290 lineto
-1340 300 lineto
-closepath
-stroke
-end grestore
-% EvalConst->Lxm
-newpath 1327 472 moveto
-1290 433 1200 339 1159 294 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1162 292 moveto
-1152 287 lineto
-1157 297 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1162 292 moveto
-1152 287 lineto
-1157 297 lineto
-closepath
-stroke
-end grestore
-% CompileData
-gsave 10 dict begin
-1519 272 50 18 ellipse_path
-stroke
-gsave 10 dict begin
-1481 267 moveto
-(CompileData)
-[9.36 6.96 10.8 6.96 3.84 3.84 6.24 10.08 6.24 3.84 6.24]
-xshow
-end grestore
-end grestore
-% EvalConst->CompileData
-newpath 1357 472 moveto
-1387 434 1462 342 1498 298 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1501 300 moveto
-1505 290 lineto
-1496 295 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1501 300 moveto
-1505 290 lineto
-1496 295 lineto
-closepath
-stroke
-end grestore
-% EvalType
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1519 489 40 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1491 484 moveto
-(EvalType)
-[8.64 6.96 6.24 3.84 8.64 6.96 6.96 6.24]
-xshow
-end grestore
-end grestore
-% EvalType->Syntaxe
-newpath 1505 472 moveto
-1474 434 1400 341 1364 297 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1366 294 moveto
-1357 289 lineto
-1361 299 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1366 294 moveto
-1357 289 lineto
-1361 299 lineto
-closepath
-stroke
-end grestore
-% EvalType->CompileData
-newpath 1519 471 moveto
-1519 433 1519 345 1519 300 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1523 300 moveto
-1519 290 lineto
-1516 300 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1523 300 moveto
-1519 290 lineto
-1516 300 lineto
-closepath
-stroke
-end grestore
-% LazyCompiler
-gsave 10 dict begin
-filled
-0.502 1.000 0.820 nodecolor
-0.502 1.000 0.820 nodecolor
-1276 1143 53 18 ellipse_path
-fill
-0.502 1.000 0.820 nodecolor
-gsave 10 dict begin
-0.000 0.000 0.000 nodecolor
-1235 1138 moveto
-(LazyCompiler)
-[8.64 6.24 6.24 6.96 9.36 6.96 10.8 6.96 3.84 3.84 6.24 4.56]
-xshow
-end grestore
-end grestore
-% LazyCompiler->Lxm
-newpath 1267 1125 moveto
-1233 1051 1102 761 1060 507 curveto
-1048 428 1094 339 1120 297 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1123 299 moveto
-1126 289 lineto
-1117 295 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1123 299 moveto
-1126 289 lineto
-1117 295 lineto
-closepath
-stroke
-end grestore
-% LazyCompiler->CompUtils
-newpath 1275 1125 moveto
-1270 1034 1247 628 1241 517 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1244 517 moveto
-1240 507 lineto
-1238 517 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1244 517 moveto
-1240 507 lineto
-1238 517 lineto
-closepath
-stroke
-end grestore
-% LazyCompiler->SrcTab
-newpath 1279 1125 moveto
-1285 1086 1301 998 1308 953 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1311 953 moveto
-1310 943 lineto
-1305 952 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1311 953 moveto
-1310 943 lineto
-1305 952 lineto
-closepath
-stroke
-end grestore
-% LazyCompiler->CompileData
-newpath 1288 1125 moveto
-1335 1053 1511 769 1568 507 curveto
-1584 432 1551 343 1532 299 curveto
-stroke
-gsave 10 dict begin
-solid
-1 setlinewidth
-0.000 0.000 0.000 edgecolor
-newpath 1535 298 moveto
-1528 290 lineto
-1529 301 lineto
-closepath
-fill
-0.000 0.000 0.000 edgecolor
-newpath 1535 298 moveto
-1528 290 lineto
-1529 301 lineto
-closepath
-stroke
-end grestore
-endpage
-showpage
-grestore
-%%PageTrailer
-%%EndPage: 1
-%%Trailer
-%%Pages: 1
-end
-restore
-%%EOF
diff --git a/src/lpp.dot b/src/lpp.dot
deleted file mode 100644
index 23145e9e..00000000
--- a/src/lpp.dot
+++ /dev/null
@@ -1,54 +0,0 @@
-digraph G {
- size="10,7.5";
- ratio="fill";
- rotate=90;
- fontsize="12pt";
- rankdir = TB ;
-"Main" [style=filled, color=darkturquoise];
-"Main" -> "Version";
-"Main" -> "Verbose";
-"Main" -> "Syntaxe";
-"Main" -> "Printf";
-"Main" -> "Parsing";
-"Main" -> "Parser";
-"Main" -> "Lxm";
-"Main" -> "List";
-"Main" -> "Lexing";
-"Main" -> "Lexer";
-"Main" -> "Format";
-"Main" -> "Filename";
-"Main" -> "Errors";
-"Main" -> "Dump";
-"Main" -> "Compile";
-"Main" -> "Arg";
-"Verbose" [style=filled, color=darkturquoise];
-"Lxm" [style=filled, color=darkturquoise];
-"Lxm" -> "Lexing";
-"CompUtils" [style=filled, color=darkturquoise];
-"CompUtils" -> "Syntaxe";
-"CompUtils" -> "Lxm";
-"CompUtils" -> "Hashtbl";
-"ExpandPack" [style=filled, color=darkturquoise];
-"ExpandPack" -> "Syntaxe";
-"ExpandPack" -> "Lxm";
-"ExpandPack" -> "Hashtbl";
-"SymbolTab" [style=filled, color=darkturquoise];
-"SymbolTab" -> "Syntaxe";
-"SymbolTab" -> "Lxm";
-"SymbolTab" -> "CompUtils";
-"SrcTab" [style=filled, color=darkturquoise];
-"SrcTab" -> "Syntaxe";
-"SrcTab" -> "SymbolTab";
-"EvalConst" [style=filled, color=darkturquoise];
-"EvalConst" -> "Syntaxe";
-"EvalConst" -> "Lxm";
-"EvalConst" -> "CompileData";
-"EvalType" [style=filled, color=darkturquoise];
-"EvalType" -> "Syntaxe";
-"EvalType" -> "CompileData";
-"LazyCompiler" [style=filled, color=darkturquoise];
-"LazyCompiler" -> "SrcTab";
-"LazyCompiler" -> "Lxm";
-"LazyCompiler" -> "CompileData";
-"LazyCompiler" -> "CompUtils";
-}
diff --git a/src/lus2licRun.ml b/src/lus2licRun.ml
new file mode 100644
index 00000000..9bf96eba
--- /dev/null
+++ b/src/lus2licRun.ml
@@ -0,0 +1,96 @@
+
+type vars = (string * string) list
+
+open MainArgs
+open Soc
+open SocExecValue
+
+let make argv =
+ let opt = MainArgs.parse argv in
+ let node = opt.main_node in
+
+ if (opt.infiles = []) then (
+ MainArgs.usage stderr opt;
+ exit 1
+ );
+ let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
+ Ident.set_dft_pack_name new_dft_pack;
+
+ let main_node =
+ if opt.main_node = "" then None else
+ Some (Ident.idref_of_string opt.main_node)
+ in
+ if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
+ let nsl = Compile.get_source_list opt opt.infiles in
+ let lic_prg = Compile.doit opt nsl main_node in
+
+ let first_file = List.hd opt.infiles in
+ let name =
+ try Filename.chop_extension (Filename.basename first_file)
+ with _ ->
+ print_string ("*** '"^first_file^"': bad file name.\n"); exit 1
+ in
+ let nk = (Lic.node_key_of_idref (Ident.to_idref name)) in
+ let sk, soc_tbl =
+ if LicPrg.node_exists lic_prg nk then (
+ print_string ("WARNING: No main node is specified. I'll try with " ^ name ^"\n");
+ flush stdout;
+ Lic2soc.f lic_prg nk
+ ) else (
+ print_string ("Error: no node is specified, cannot exec.\n");
+ flush stdout;
+ exit 1
+ )
+ in
+ (* SocExec.f zesoc msk *)
+
+ let soc = try Soc.SocMap.find sk soc_tbl with Not_found -> assert false in
+ let vntl_of_profile = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) in
+ let (vntl_i:Data.vntl) = vntl_of_profile (fst soc.profile) in
+ let (vntl_o:Data.vntl) = vntl_of_profile (snd soc.profile) in
+ let oc = stdout in
+ Verbose.dump_entete oc;
+ Rif_base.write_interface oc vntl_i vntl_o None None;
+ Rif_base.flush oc;
+
+ let (to_soc_subst : SocExecValue.substs -> Data.subst list) =
+ fun s -> SocExecValue.filter_top_subst s
+ in
+ let (add_subst : Data.subst list -> SocExecValue.substs -> SocExecValue.substs) =
+ fun s ctx_s ->
+ 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
+ let step sl_in =
+ let ctx = { !ctx_ref with s = add_subst sl_in !ctx_ref.s } in
+ let ctx = SocExec.do_step soc_tbl soc ctx in
+ let sl_out = to_soc_subst ctx.s in
+ ctx_ref := ctx;
+ sl_out
+ in
+ let step_dbg sl ctx cont =
+ {
+ Event.nb = Event.get_nb ();
+ Event.step = ctx.Event.ctx_step;
+ Event.depth = ctx.Event.ctx_depth;
+ Event.kind = Event.Node
+ {
+ Event.lang = "lustre";
+ Event.port = Event.Exit("",Expr.True (* XXX *),fun () -> []);
+ Event.name = "xxx";
+ Event.inputs = [] ;
+ Event.outputs = [];
+
+ };
+ Event.other = "";
+ Event.data = ctx.Event.ctx_data;
+ Event.next = (fun () -> cont (step sl) ctx);
+ Event.terminate = ctx.Event.ctx_terminate;
+ }
+ in
+ let (node_in: vars) = [] in
+ let (node_out: vars) = [] in
+ let (mems_in : Data.subst list) = [] in
+ let (mems_out : Data.subst list) = [] in
+ node_in, node_out, (fun _ -> ()), step, step_dbg, mems_in, mems_out
+
diff --git a/src/lus2licRun.mli b/src/lus2licRun.mli
new file mode 100644
index 00000000..5be04796
--- /dev/null
+++ b/src/lus2licRun.mli
@@ -0,0 +1,9 @@
+
+
+type vars = (string * string) list
+
+val make: string array ->
+ vars * vars * (string -> unit)
+ * (Data.subst list -> Data.subst list)
+ * (Data.subst list -> Event.ctx -> (Data.subst list -> Event.ctx -> Event.t) -> Event.t)
+ * Data.subst list * Data.subst list
diff --git a/src/lxm.ml b/src/lxm.ml
index eb580400..07b1602f 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -1,11 +1,10 @@
-(* Time-stamp: <modified the 01/02/2013 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 09/04/2013 (at 17:21) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
-
let new_line ( lexbuf ) = (
- Global.line_start_pos := Lexing.lexeme_end lexbuf;
- incr Global.line_num;
+ MainArgs.global_opt.MainArgs.line_start_pos <- Lexing.lexeme_end lexbuf;
+ MainArgs.global_opt.MainArgs.line_num <- MainArgs.global_opt.MainArgs.line_num +1;
()
)
@@ -31,7 +30,7 @@ let file x = x._file
let pragma x = x._pragma
(* affichage standard: *)
let details lxm = (
- let file = if !Global.nonreg_test then
+ let file = if MainArgs.global_opt.MainArgs.nonreg_test then
(* during non-regression test, having absolute paths printed
complicate the perusal (because of the diff output). *)
Filename.basename lxm._file
@@ -60,7 +59,7 @@ let (flagit : 'a -> t -> 'a srcflagged) =
let dummy str =
{
_str = str ;
- _file = String.concat ", " !Global.infiles ;
+ _file = "dummy";
_line = 0 ;
_cstart = 0 ;
_cend = 0 ;
@@ -69,14 +68,16 @@ let dummy str =
let last_lexeme = ref (dummy "")
+open MainArgs
+
let make ( lexbuf ) = (
let s = (Lexing.lexeme lexbuf) in
- let l = !Global.line_num in
- let c1 = (Lexing.lexeme_start lexbuf - !Global.line_start_pos) in
- let c2 = (Lexing.lexeme_end lexbuf - !Global.line_start_pos - 1) in
+ let l = global_opt.line_num in
+ let c1 = (Lexing.lexeme_start lexbuf - global_opt.line_start_pos) in
+ let c2 = (Lexing.lexeme_end lexbuf - global_opt.line_start_pos - 1) in
last_lexeme :=
{ _str = s ;
- _file = !Global.current_file;
+ _file = global_opt.current_file;
_line = l;
_cstart = c1 ;
_cend = c2 ;
diff --git a/src/main.ml b/src/main.ml
index 3ee33f6c..0c7078cb 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,6 +1,4 @@
-(* Time-stamp: <modified the 03/04/2013 (at 15:10) by Erwan Jahier> *)
-
-
+(* Time-stamp: <modified the 10/04/2013 (at 09:52) by Erwan Jahier> *)
open Verbose
open AstV6
@@ -10,141 +8,11 @@ open Errors
open Parsing
open Format
-let test_lex ( lexbuf ) = (
- let tk = ref (Lexer.lexer lexbuf) in
- while !tk <> Parser.TK_EOF do
- match (Lexer.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 := (Lexer.lexer lexbuf)
- done
-)
-
-(* Retourne un AstV6.t *)
-let lus_load lexbuf =
- let tree = Parser.program Lexer.lexer lexbuf in
- LicName.update_fresh_var_prefix ();
- (* ICI *)
- AstRecognizePredef.f tree
-
-
-type maybe_packed =
- | Packed of AstV6.pack_or_model
- | Unpacked of AstV6.packbody
-
-
-let (get_source_list : string list -> AstV6.pack_or_model list) =
- fun infile_list ->
- let (get_one_source : string -> string list * maybe_packed list) =
- fun infile ->
- let incl_files, l =
- let lexbuf = Global.lexbuf_of_file_name infile in
- if !Global.tlex then test_lex lexbuf;
- match (lus_load lexbuf) with
- | PRPackBody(incl_files, pbdy) -> incl_files, [Unpacked pbdy]
- | PRPack_or_models(incl_files, nsl) -> incl_files, (List.map (fun ns -> Packed ns) nsl)
- in
- (* If included files have a relative path, strange things may happen.
- Hence we make the path absolute, using the directory of the includer.
- *)
- let includer_dir = Filename.dirname infile in
- let fix_dir f = if Filename.is_relative f then Filename.concat includer_dir f else f in
- let incl_files = List.map fix_dir incl_files in
- incl_files, l
- in
- let rec (get_remaining_source_list : maybe_packed list * string list * string list ->
- maybe_packed list * string list * string list) =
- fun (pack_acc, compiled, to_be_compiled) ->
- match to_be_compiled with
- | [] -> (pack_acc, compiled, [])
- | infile::tail ->
- let infile = FilenameExtras.simplify infile in
- if List.mem infile compiled then
- get_remaining_source_list (pack_acc, compiled, tail)
- else
- let included_files, pack = get_one_source infile in
- let new_pack_acc = pack_acc@pack in
- get_remaining_source_list(
- new_pack_acc,
- infile::compiled,
- tail@included_files)
- in
- let infile_list =
- (* We need absolute paths to make sure that files are not
- included several times. Indeed, otherwise,
- FilenameExtras.simplify may miss some simplifications. For
- example, consider the files "../../x/toto.lus" and
- "../toto.lus". They actually refer to the same file if the
- current directory is a sub-directory of "x". Working with
- absolute paths solves the problem.
-
- *)
- let make_it_absolute f =
- if Filename.is_relative f then Filename.concat (Sys.getcwd ()) f else f
- in
- List.map make_it_absolute infile_list
- in
- let first_file = assert (infile_list <> []); List.hd infile_list in
- let included_files, first_pack = get_one_source first_file in
- let (pack_list, _compiled_files, included_files) =
- get_remaining_source_list (first_pack, [first_file], (List.tl infile_list) @ included_files)
- in
- let _ = assert (included_files=[]) in
- let packed_list, unpacked_list =
- List.fold_left
- (fun (pl, upl) p ->
- match p with
- | Packed p -> p::pl, upl
- | Unpacked up -> pl, up::upl
- )
- ([], [])
- pack_list
- in
- let unpacked_merged_opt = (* All unpacked files are merged into one single package *)
- List.fold_left
- (fun acc pbody ->
- match acc with
- | None -> Some pbody
- | Some pbody_acc ->
- let add tbl x y =
- (* Let's perform some clashes checks *)
- if Hashtbl.mem tbl x then
- let ybis = Hashtbl.find tbl x in
- print_string ("*** Error: "^(Ident.to_string x)^" is defined twice: \n\t" ^
- (Lxm.details y.src) ^ "\n\t" ^
- (Lxm.details ybis.src) ^ ".\n");
- exit 2
- else
- Hashtbl.add tbl x y
- in
- Hashtbl.iter (fun x y -> add pbody_acc.pk_const_table x y) pbody.pk_const_table;
- Hashtbl.iter (fun x y -> add pbody_acc.pk_type_table x y) pbody.pk_type_table;
- Hashtbl.iter (fun x y -> add pbody_acc.pk_node_table x y) pbody.pk_node_table;
- Some { pbody_acc with
- pk_def_list=pbody_acc.pk_def_list@pbody.pk_def_list;
- }
- )
- None
- unpacked_list
- in
- match unpacked_merged_opt with
- | None -> packed_list
- | Some unpacked_merged ->
- let name =
- try Filename.chop_extension (Filename.basename first_file)
- with _ ->
- print_string ("*** '"^first_file^"': bad file name.\n"); exit 1
- in
- let pi = AstV6.give_pack_this_name (Ident.pack_name_of_string name) unpacked_merged in
- let p = NSPack (Lxm.flagit pi (Lxm.dummy name)) in
- p::packed_list
-
-
-let my_exit i =
- close_out !Global.oc;
- if Sys.file_exists !Global.outfile then Sys.remove !Global.outfile;
+open MainArgs
+let my_exit opt i =
+ close_out opt.oc;
+ if Sys.file_exists opt.outfile then Sys.remove opt.outfile;
exit i
let rec first_pack_in =
@@ -153,37 +21,37 @@ let rec first_pack_in =
| (AstV6.NSModel _)::tail -> first_pack_in tail
| [] -> raise (Global_error "No package has been provided")
-let main = (
+let main = (
(* Compile.init_appli () ; *)
(* parse_args (); *)
- let args = MainArgs.parse Sys.argv in
+ let opt = MainArgs.parse Sys.argv in
Verbose.exe ~level:3 (fun () ->
Gc.set { (Gc.get ()) with Gc.verbose = 0x01 }
);
- if !Global.run_unit_test then (
+ if opt.run_unit_test then (
UnifyType.unit_test ();
exit 0
);
- if (!Global.infiles = []) then (
- MainArgs.usage stderr args;
+ if (opt.infiles = []) then (
+ MainArgs.usage stderr opt;
exit 1
);
- let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd !Global.infiles)) in
+ let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
Ident.set_dft_pack_name new_dft_pack;
let main_node =
- if !Global.main_node = "" then None else
- Some (Ident.idref_of_string !Global.main_node)
+ if opt.main_node = "" then None else
+ Some (Ident.idref_of_string opt.main_node)
in
- if !Global.outfile <> "" then Global.oc := open_out !Global.outfile;
- try (
- let nsl = get_source_list !Global.infiles in
- let lic_prg = Compile.doit nsl main_node in
+ if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
+ (try (
+ let nsl = Compile.get_source_list opt opt.infiles in
+ let lic_prg = Compile.doit opt nsl main_node in
- if !Global.exec then
+ if opt.exec then
(match main_node with
| None -> (
- let first_file = List.hd !Global.infiles in
+ let first_file = List.hd opt.infiles in
let name =
try Filename.chop_extension (Filename.basename first_file)
with _ ->
@@ -194,7 +62,7 @@ let main = (
print_string ("WARNING: No main node is specified. I'll try with " ^ name ^"\n");
flush stdout;
let msk, zesoc = Lic2soc.f lic_prg nk in
- SocExec.f zesoc msk
+ SocExec.f opt zesoc msk
) else (
print_string ("Error: no node is specified, cannot exec.\n");
flush stdout;
@@ -203,45 +71,45 @@ let main = (
)
| Some main_node ->
let msk, zesoc = Lic2soc.f lic_prg (Lic.node_key_of_idref main_node) in
- SocExec.f zesoc msk
+ SocExec.f opt zesoc msk
) else (
- LicPrg.to_file !Global.oc lic_prg main_node
+ LicPrg.to_file opt lic_prg main_node
);
Verbose.exe ~level:3 (fun () -> Gc.print_stat stdout);
- ) with
+ ) with
Sys_error(s) ->
prerr_string (s^"\n");
- my_exit 1
+ my_exit opt 1
| Global_error s ->
print_global_error s ;
- my_exit 1
+ my_exit opt 1
| Parse_error ->
print_compile_error (Lxm.last_made ()) "syntax error";
- my_exit 1
+ my_exit opt 1
| Unknown_var(lxm,id) ->
print_compile_error lxm ("unknown variable (" ^ (Ident.to_string id) ^")")
| Unknown_constant(lxm,str) ->
print_compile_error lxm ("unknown constant (" ^ str ^")")
| Compile_error(lxm,msg) ->
print_compile_error lxm msg;
- my_exit 1
+ my_exit opt 1
| L2lCheckLoops.Error(lxm,msg,lic_prg) ->
(* Sometime it helps to see the current state of the faulty program *)
- LicPrg.to_file !Global.oc lic_prg main_node;
- flush !Global.oc;
+ LicPrg.to_file opt lic_prg main_node;
+ flush opt.oc;
print_compile_error lxm msg;
- my_exit 1
+ my_exit opt 1
| Assert_failure (file, line, col) ->
prerr_string (
"\n*** oops: lus2lic internal error\n\tFile \""^ file ^
"\", line " ^ (string_of_int line) ^ ", column " ^
(string_of_int col) ^ "\n*** when compiling lustre program" ^
- (if List.length !Global.infiles > 1 then "s " else " ") ^
- (String.concat ", " !Global.infiles) ^ "\n"^
+ (if List.length opt.infiles > 1 then "s " else " ") ^
+ (String.concat ", " opt.infiles) ^ "\n"^
"\n*** You migth want to sent a bug report to "^Version.maintainer ^"\n") ;
- my_exit 2
-
+ my_exit opt 2
+ );
(* | Compile_node_error(nkey,lxm,msg) -> ( *)
(* print_compile_node_error nkey lxm msg ; *)
(* exit 1 *)
@@ -251,5 +119,6 @@ let main = (
(* exit 1 *)
(* ) *)
+ close_out opt.oc
+
);
- close_out !Global.oc
diff --git a/src/mainArgs.ml b/src/mainArgs.ml
index f393f2e8..78e72dd8 100644
--- a/src/mainArgs.ml
+++ b/src/mainArgs.ml
@@ -11,38 +11,105 @@ let tool_name = Version.tool
let usage_msg = "usage: "^tool_name^" [options] <file> | "^tool_name^" -help"
type t = {
- mutable _opts : (string * Arg.spec * string) list; (* classical Arg option tab used by Arg.parse *)
- mutable _user_man : (string * string list) list; (* ad hoc tab for pretty prtting usage *)
- mutable _hidden_man: (string * string list) list; (* ad hoc tab for pretty prtting usage *)
- mutable _others: string list;
- mutable _margin : int;
-
+ mutable opts : (string * Arg.spec * string) list; (* classical Arg option tab used by Arg.parse *)
+ mutable user_man : (string * string list) list; (* ad hoc tab for pretty prtting usage *)
+ mutable hidden_man: (string * string list) list; (* ad hoc tab for pretty prtting usage *)
+ mutable others: string list;
+ mutable margin : int;
+ mutable outfile : string;
+ mutable infiles : string list;
+ mutable main_node : string;
+ mutable compile_all_items : bool;
+ mutable run_unit_test : bool;
+ mutable inline_iterator : bool;
+ mutable expand_nodes : bool;
+ mutable dont_expand_nodes : string list;
+ mutable expand_enums : bool;
+ mutable expand_arrays : bool;
+ mutable oc : Pervasives.out_channel;
+ mutable tlex : bool;
+ mutable exec : bool;
}
+(* Those are really too boring to be functionnal (used in all over the places) *)
+type global_opt = {
+ mutable lv4 : bool;
+ mutable ec : bool;
+ mutable one_op_per_equation : bool;
+ mutable no_prefix : bool;
+ mutable nonreg_test : bool;
+ mutable current_file : string;
+ mutable line_num : int;
+ mutable line_start_pos : int;
+}
+let (global_opt:global_opt) =
+ {
+ lv4 = false;
+ ec = false;
+ one_op_per_equation = true;
+ no_prefix = false;
+ nonreg_test = false;
+ line_num = 1;
+ line_start_pos = 0;
+ current_file = "";
+ }
let (make_opt : unit -> t) =
fun () ->
- {
- _opts = [];
- _user_man = [];
- _hidden_man = [];
- _others = [];
- _margin = 12;
-}
+ {
+ opts = [];
+ user_man = [];
+ hidden_man = [];
+ others = [];
+ margin = 12;
+ outfile = "";
+ infiles = [];
+ main_node = "";
+ compile_all_items = true;
+ run_unit_test = false;
+ inline_iterator = false;
+ expand_nodes = false;
+ dont_expand_nodes = [];
+ expand_enums = false;
+ expand_arrays = false;
+ (** the output channel *)
+ oc = Pervasives.stdout;
+ tlex = false;
+ exec = false;
+ }
+
+
+(** flag 'paranoid' utile pour forcer (via le mecanisme Verbose.exe)
+ des vérifs de trucs douteux ...
+*)
+let paranoid = Some (Verbose.get_flag "paranoid")
+
+let (lexbuf_of_file_name : string -> Lexing.lexbuf) =
+fun file ->
+ let inchannel =
+ Verbose.print_string ~level:1
+(* ("Opening file " ^ (Filename.concat (Sys.getcwd ()) file) ^ "\n"); *)
+ ("Opening file " ^ (file) ^ "\n");
+ open_in file
+ in
+ global_opt.line_num <- 1;
+ global_opt.line_start_pos <- 0;
+ global_opt.current_file <- file;
+ Lexing.from_channel inchannel
(* all unrecognized options are accumulated *)
let (add_other : t -> string -> unit) =
fun opt s ->
- opt._others <- s::opt._others
+ opt.others <- s::opt.others
let pspec os opt (c, ml) = (
let (m1, oth) = match ml with
| h::t -> (h,t)
| _ -> ("",[])
in
- let t2 = String.make opt._margin ' ' in
+ let t2 = String.make opt.margin ' ' in
let cl = String.length c in
- let t1 = if (cl < opt._margin ) then
- String.make (opt._margin - cl) ' '
+ let t1 = if (cl < opt.margin ) then
+ String.make (opt.margin - cl) ' '
else
"\n"^t2
in
@@ -52,7 +119,7 @@ let pspec os opt (c, ml) = (
)
let usage os opt = (
- let l = List.rev opt._user_man in
+ let l = List.rev opt.user_man in
Printf.fprintf os "%s\n\n" usage_msg;
List.iter (pspec os opt) l
)
@@ -62,9 +129,9 @@ let help opt ()= (
)
let full_usage os opt = (
Printf.fprintf os "%s\n" usage_msg;
-(* let l = List.rev opt._user_man in *)
+(* let l = List.rev opt.user_man in *)
(* List.iter (pspec os opt) l; *)
- let l = List.rev (opt._hidden_man) in
+ let l = List.rev (opt.hidden_man) in
List.iter (pspec os opt) l
)
let full_help opt ()= (
@@ -87,12 +154,12 @@ let file_notfound f opt = (
let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec -> string list -> unit) =
fun opt ol ?(hide=false) ?(arg="") se ml ->
- let treto o = opt._opts <- (o, se, "")::opt._opts in
+ let treto o = opt.opts <- (o, se, "")::opt.opts in
List.iter treto ol ;
let col1 = (String.concat ", " ol)^arg in
if hide
- then opt._hidden_man <- (col1, ml)::opt._hidden_man
- else opt._user_man <- (col1, ml)::opt._user_man
+ then opt.hidden_man <- (col1, ml)::opt.hidden_man
+ else opt.user_man <- (col1, ml)::opt.user_man
(*
let tabs = String.make (col - (String.length o) - (String.length arg)) ' ' in
(* (o, se, arg^tabs^m) *)
@@ -100,17 +167,17 @@ let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec -> string
*)
(* utils *)
-let set_v4_options () =
- Global.lv4 := true;
- Global.inline_iterator := true;
- Global.expand_arrays := true;
- Global.expand_enums := true
+let set_v4_options opt =
+ global_opt.lv4 <- true;
+ opt.inline_iterator <- true;
+ opt.expand_arrays <- true;
+ opt.expand_enums <- true
-let set_ec_options () =
- set_v4_options ();
- Global.ec := true;
- Global.no_prefix := true;
- Global.expand_nodes := true
+let set_ec_options opt =
+ set_v4_options opt;
+ global_opt.ec <- true;
+ global_opt.no_prefix <- true;
+ opt.expand_nodes <- true
(*** USER OPTIONS TAB **)
let mkoptab (opt:t) : unit = (
@@ -118,71 +185,71 @@ let mkoptab (opt:t) : unit = (
["-n";"-node"]
~arg:" <string>"
(Arg.String(function x ->
- Global.main_node := x;
- Global.compile_all_items := false))
+ opt.main_node <- x;
+ opt.compile_all_items <- false))
["Set the main node (all items are compiled if unset)"]
;
mkopt opt
["-o";"--output-file"]
~arg:" <string>"
(Arg.String(function x ->
- Global.outfile := x))
+ opt.outfile <- x))
["Set the output file name"]
;
mkopt opt
["-exec"]
- (Arg.Unit (fun _ -> Global.exec := true))
+ (Arg.Unit (fun _ -> opt.exec <- true))
["interpret the program using RIF conventions for I/O (experimental)."]
;
mkopt opt
["-knc"; "--keep-nested-calls"]
- (Arg.Unit (fun _ -> Global.one_op_per_equation := false))
+ (Arg.Unit (fun _ -> global_opt.one_op_per_equation <- false))
["Keep nested calls (inhibited by -en). By default, only one node per equation is generated."]
;
mkopt opt
["-ei"; "--expand-iterators"]
- (Arg.Unit (fun _ -> Global.inline_iterator := true))
+ (Arg.Unit (fun _ -> opt.inline_iterator <- true))
["Expand array iterators (i.e., generate iterator-free code)."]
;
mkopt opt
["-ee"; "--expand-enums"]
- (Arg.Unit (fun _ -> Global.expand_enums := true))
+ (Arg.Unit (fun _ -> opt.expand_enums <- true))
[" Translate enums using extern types and consts (for lv4 and ec)."]
;
mkopt opt
["-esa"; "--expand-structs-and-arrays"]
(Arg.Unit (fun _ ->
- Global.expand_arrays := true;
- Global.inline_iterator := true))
+ opt.expand_arrays <- true;
+ opt.inline_iterator <- true))
["Expand structures and arrays using as many variables as necessary (automatically impose '-ei')"]
;
mkopt opt
["-en"; "--expand-nodes"]
- (Arg.Unit (fun _ -> Global.expand_nodes := true))
+ (Arg.Unit (fun _ -> opt.expand_nodes <- true))
["Expand the main node (use the first node if no one is specified)."]
;
mkopt opt
["-den"; "--do_not-expand-nodes"]
~arg:" <string>"
(Arg.String (fun str ->
- Global.dont_expand_nodes := str::!Global.dont_expand_nodes
+ opt.dont_expand_nodes <- str::opt.dont_expand_nodes
))
["Do not expand the specified node (meaningful with -en only of course)."]
;
mkopt opt
["-lv4"; "--lustre-v4"]
- (Arg.Unit (fun _ -> set_v4_options ()))
+ (Arg.Unit (fun _ -> set_v4_options opt))
["Use Lustre V4 syntax (automatically impose '-ei -ee -esa')."]
;
mkopt opt
["-ec"; "--expanded-code"]
- (Arg.Unit (fun _ -> set_ec_options ()))
+ (Arg.Unit (fun _ -> set_ec_options opt))
["Generate ec (actually just an alias for '-en -lv4 --no-prefix')."]
;
mkopt opt
["-np"; "--no-prefix"]
- (Arg.Set Global.no_prefix)
+ (Arg.Unit (fun () -> global_opt.no_prefix <- true))
["Do not prefix variable names by their module (beware: variable names may clash with this option)."]
;
@@ -211,7 +278,7 @@ let mkoptab (opt:t) : unit = (
(* to show Hidden opt *)
mkopt opt
["-more"]
- (* (Arg.Unit(fun _ -> opt._see_all_options <- true)) *)
+ (* (Arg.Unit(fun _ -> opt.see_all_options <- true)) *)
(Arg.Unit (full_help opt))
["Show hidden options (for dev purposes)"];
(* HIDDEN *)
@@ -219,24 +286,24 @@ let mkoptab (opt:t) : unit = (
(* test lexical *)
mkopt opt ~hide:true
["-tlex"; "--test-lexer"]
- (Arg.Set Global.tlex)
+ (Arg.Unit (fun () -> opt.tlex <- true))
["Test the lexical analysis"]
;
(* test syntaxique
mkopt opt ~hide:true
["-tparse"]
- (Arg.Unit(function _ -> opt._gen_mode <- GenLuc ; opt._test_parse <- true ; ()))
+ (Arg.Unit(function _ -> opt.gen_mode <- GenLuc ; opt.test_parse <- true ; ()))
["Test the syntactic analysis"]
;
*)
mkopt opt ~hide:true
["-unit"]
- (Arg.Set Global.run_unit_test)
+ (Arg.Unit (fun () -> opt.run_unit_test<-true))
["Run embedded unit tests"]
;
mkopt opt ~hide:true
["--nonreg-test"]
- (Arg.Set Global.nonreg_test)
+ (Arg.Unit (fun () -> global_opt.nonreg_test <- true))
["Avoid printing full path error msgs to ease non-reg test decision"]
;
(* misc debug flag *)
@@ -265,7 +332,7 @@ let parse argv = (
let save_current = !current in
try (
mkoptab opt;
- Arg.parse_argv ~current:current argv opt._opts (add_other opt) usage_msg;
+ Arg.parse_argv ~current:current argv opt.opts (add_other opt) usage_msg;
(List.iter
(fun f ->
if (String.sub f 0 1 = "-") then
@@ -274,9 +341,9 @@ let parse argv = (
file_notfound f opt
else ()
)
- opt._others
+ opt.others
);
- Global.infiles := (List.rev opt._others);
+ opt.infiles <- (List.rev opt.others);
current := save_current;
opt
) with
diff --git a/src/mainArgs.mli b/src/mainArgs.mli
index b00eae1d..91b0da82 100644
--- a/src/mainArgs.mli
+++ b/src/mainArgs.mli
@@ -2,7 +2,41 @@
(* koketeri, vu qu'on continu à ranger concetement
les options dans des var. globales ! (cf Global
*)
-type t
+type t = {
+ mutable opts : (string * Arg.spec * string) list; (* classical Arg option tab used by Arg.parse *)
+ mutable user_man : (string * string list) list; (* ad hoc tab for pretty prtting usage *)
+ mutable hidden_man: (string * string list) list; (* ad hoc tab for pretty prtting usage *)
+ mutable others: string list;
+ mutable margin : int;
+ mutable outfile : string;
+ mutable infiles : string list;
+ mutable main_node : string;
+ mutable compile_all_items : bool;
+ mutable run_unit_test : bool;
+ mutable inline_iterator : bool;
+ mutable expand_nodes : bool;
+ mutable dont_expand_nodes : string list;
+ mutable expand_enums : bool;
+ mutable expand_arrays : bool;
+ mutable oc : Pervasives.out_channel;
+ mutable tlex : bool;
+ mutable exec : bool;
+}
+
+(* Those are really too boring to be functionnal (used in all over the places) *)
+type global_opt = {
+ mutable lv4 : bool;
+ mutable ec : bool;
+ mutable one_op_per_equation : bool;
+ mutable no_prefix : bool;
+ mutable nonreg_test : bool;
+ mutable current_file : string;
+ mutable line_num : int;
+ mutable line_start_pos : int;
+}
+val paranoid : Verbose.flag option
+
+val global_opt:global_opt
(* La ``méthode'' principale *)
val parse : string array -> t
@@ -10,3 +44,4 @@ val parse : string array -> t
val usage : out_channel -> t -> unit
val full_usage : out_channel -> t -> unit
+val lexbuf_of_file_name : string -> Lexing.lexbuf
diff --git a/src/socExec.ml b/src/socExec.ml
index 05c74cf6..68e964a4 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/04/2013 (at 14:58) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 10:25) by Erwan Jahier> *)
open Soc
open Data
@@ -179,7 +179,7 @@ and (filter_params : Soc.t -> Soc.var list -> int list -> Soc.var list) =
let res = List.map (fun i -> local_nth i el) il in
res
-(* expand struct and arrays when communicating with the outside world (a good idea?) *)
+(* exported *)
let rec (expand_profile:Soc.var list -> Soc.var list) =
fun vl ->
let res = List.flatten (List.map expand_var vl) in
@@ -277,50 +277,62 @@ let (unexpand : sl -> Soc.var list -> sl) =
assert (remaining=[]);
res
-let (read_soc_input : Soc.t -> out_channel -> substs -> substs) =
- fun soc oc ctx_s ->
- let profile = expand_profile (fst soc.profile) in
- let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in
- let s:Data.subst list = Rif_base.read stdin (Some oc) vntl in
- let s = unexpand s (fst soc.profile) in
+(* [add_data_subst vtnl data_s s] add the data_s to s; *)
+let (add_data_subst : var list -> Data.subst list -> SocExecValue.substs -> SocExecValue.substs) =
+ fun vntl_i s ctx_s ->
+ let s = unexpand s vntl_i in
List.fold_left (fun acc (id,v) -> sadd acc [id] v) ctx_s s
-let rec (loop_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> int -> out_channel -> unit) =
- fun soc_tbl soc ctx step_nb oc ->
+let (read_soc_input : var list -> Data.vntl -> out_channel -> substs -> substs) =
+ fun vntl_i exp_vntl_i_str oc ctx_s ->
+ let s:Data.subst list = Rif_base.read stdin (Some oc) exp_vntl_i_str in
+ add_data_subst vntl_i s ctx_s
+
+let rec (loop_step : Soc.tbl -> Soc.var list -> Data.vntl -> Data.vntl
+ -> Soc.t -> SocExecValue.ctx -> int -> out_channel -> unit) =
+ fun soc_tbl vntl_i exp_vntl_i_str exp_vntl_o_str soc ctx step_nb oc ->
Rif_base.write oc ("\n#step " ^ (string_of_int step_nb)^"\n");
- let ctx = { ctx with s = read_soc_input soc oc ctx.s } in
+ let ctx = { ctx with s = read_soc_input vntl_i exp_vntl_i_str oc ctx.s } in
let step = match soc.step with [step] -> step | _ -> assert false in
let ctx = soc_step step soc_tbl soc ctx in
let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false)} in
(* dump_substs ctx.s; *)
- let profile = expand_profile (snd soc.profile) in
- let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in
let s = SocExecValue.filter_top_subst ctx.s in
let s = List.flatten(List.map expand_subst s) in
Rif_base.write oc " #outs ";
- Rif_base.write_outputs oc vntl s;
+ Rif_base.write_outputs oc exp_vntl_o_str s;
Rif_base.flush oc;
Verbose.exe ~flag:dbg (fun () -> dump_substs ctx.s; flush stdout);
- loop_step soc_tbl soc ctx (step_nb+1) oc
+ loop_step soc_tbl vntl_i exp_vntl_i_str exp_vntl_o_str soc ctx (step_nb+1) oc
+
+
+let rec (do_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> SocExecValue.ctx) =
+ fun soc_tbl soc ctx ->
+ let step = match soc.step with [step] -> step | _ -> assert false in
+ let ctx = soc_step step soc_tbl soc ctx in
+ let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
+ ctx
-let (f : Soc.tbl -> Soc.key -> unit) =
- fun soc_tbl sk ->
+let (f : MainArgs.t -> Soc.tbl -> Soc.key -> unit) =
+ fun opt soc_tbl sk ->
let soc = try SocMap.find sk soc_tbl with Not_found -> assert false in
let ctx = SocExecValue.create_ctx soc_tbl soc in
let vntl_of_profile = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) in
- let vntl_i = vntl_of_profile (expand_profile (fst soc.profile)) in
- let vntl_o = vntl_of_profile (expand_profile (snd soc.profile)) in
+ let exp_vntl_i = expand_profile (fst soc.profile) in
+ let exp_vntl_o = expand_profile (snd soc.profile) in
+ let exp_vntl_i_str = vntl_of_profile exp_vntl_i in
+ let exp_vntl_o_str = vntl_of_profile exp_vntl_o in
let oc =
- if !Global.outfile = "" then stdout else
+ if opt.MainArgs.outfile = "" then stdout else
let rif_file =
- try (Filename.chop_extension !Global.outfile) ^ ".rif"
- with _ -> !Global.outfile ^ ".rif"
+ try (Filename.chop_extension opt.MainArgs.outfile) ^ ".rif"
+ with _ -> opt.MainArgs.outfile ^ ".rif"
in
open_out rif_file
in
Verbose.dump_entete oc;
- Rif_base.write_interface oc vntl_i vntl_o None None;
+ Rif_base.write_interface oc exp_vntl_i_str exp_vntl_o_str None None;
Rif_base.flush oc;
- try loop_step soc_tbl soc ctx 1 oc
+ try loop_step soc_tbl (fst soc.profile) exp_vntl_i_str exp_vntl_o_str soc ctx 1 oc
with Rif_base.Bye ->
close_out oc
diff --git a/src/socExec.mli b/src/socExec.mli
index 2ec03e2f..043c4fce 100644
--- a/src/socExec.mli
+++ b/src/socExec.mli
@@ -1,3 +1,10 @@
-(* Time-stamp: <modified the 14/03/2013 (at 16:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 10:25) by Erwan Jahier> *)
-val f : Soc.tbl -> Soc.key -> unit
+val f : MainArgs.t -> Soc.tbl -> Soc.key -> unit
+
+
+val do_step : Soc.tbl -> Soc.t -> SocExecValue.ctx -> SocExecValue.ctx
+
+
+(* Expand struct and arrays when communicating with the outside world *)
+val expand_profile : Soc.var list -> Soc.var list
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index 5aea8e33..5b0e3ab9 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/04/2013 (at 14:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 10:00) by Erwan Jahier> *)
let dbg = Some(Verbose.get_flag "exec")
diff --git a/src/socExecValue.mli b/src/socExecValue.mli
index d839f340..79cd77a3 100644
--- a/src/socExecValue.mli
+++ b/src/socExecValue.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/04/2013 (at 14:46) by Erwan Jahier> *)
+(* Time-stamp: <modified the 10/04/2013 (at 10:00) by Erwan Jahier> *)
(** Manipulating data in the Soc interpreter *)
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index f659e889..0842f20b 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Mon Apr 8 14:52:24 2013
+Test Run By jahier on Tue Apr 9 18:30:52 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
--
GitLab