From 1d20eed20d78e289cbc4a691bfa6fe25b79b95d2 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 30 May 2008 17:24:33 +0200
Subject: [PATCH] Fix the line number that was wrong in error messages when
compiling several files (well, for the first file, the numbers were ok :-).
Also, begin to sort out a little bit the mess in the Global module.
Moreover, augment the necessary print level of most internal structure
dumping function.
---
src/Makefile | 2 +-
src/TODO | 5 +-
src/compile.ml | 6 +-
src/global.ml | 49 ++++---
src/lazyCompiler.ml | 12 +-
src/lxm.ml | 24 ++--
src/main.ml | 132 ++++++++----------
src/syntaxTab.ml | 24 ++--
.../packageTableau.lus | 6 +-
src/test/test.res.exp | 2 +-
10 files changed, 125 insertions(+), 137 deletions(-)
diff --git a/src/Makefile b/src/Makefile
index 845791fb..6c1f830c 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -8,9 +8,9 @@ OCAMLC=ocamlc
ifndef SOURCES
SOURCES = \
./version.ml \
- ./global.ml \
./verbose.mli \
./verbose.ml \
+ ./global.ml \
./ident.mli \
./ident.ml \
./lxm.mli \
diff --git a/src/TODO b/src/TODO
index e85ae349..517afb43 100644
--- a/src/TODO
+++ b/src/TODO
@@ -124,12 +124,9 @@ generer les lexemes qui vont bien,
* Dans les messages d'erreurs, le numero de colonne est faux à cause des tabulations
-* quand je passe 2 fichiers en arg de la ligne de commande, sur
- numero de ligne du 2eme est faux (pas remis a 0).
-
* Verifier que les fonctions sont des fonctions etc.
-
+* Encapsuler le module Global.
*** moins facile
diff --git a/src/compile.ml b/src/compile.ml
index 8520ca86..c1833122 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 16:08) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 17:14) by Erwan Jahier> *)
open Lxm
@@ -13,8 +13,6 @@ let rec first_pack_in =
| (NSModel _)::tail -> first_pack_in tail
| [] -> raise (Global_error "No package has been provided")
-open Global
-
let (doit : SyntaxTree.pack_or_model list -> Ident.idref option -> unit) =
fun srclist main_node ->
@@ -44,7 +42,7 @@ let (doit : SyntaxTree.pack_or_model list -> Ident.idref option -> unit) =
"-- MAIN NODE: \"%s\"\n"
(CompiledDataDump.string_of_node_key main_node_key);
- if Global.vars.compile_all_items then
+ if !Global.compile_all_items then
LazyCompiler.compile_all lzcomp
else
ignore(LazyCompiler.node_check lzcomp main_node_key
diff --git a/src/global.ml b/src/global.ml
index 4526ff31..76fa37dd 100644
--- a/src/global.ml
+++ b/src/global.ml
@@ -1,24 +1,37 @@
-(** Time-stamp: <modified the 28/05/2008 (at 14:08) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 17:19) by Erwan Jahier> *)
-(** Some global variables *)
+(** Some global variables.
-type t = {
- mutable outfile : string;
- mutable infiles : string list;
- mutable current_file : string;
- mutable main_node : string;
- mutable compile_all_items : bool;
- mutable run_unit_test : bool
-}
+ It is quite ugly, but all this kind of uglyness is here and nowhere else
+*)
-let vars = {
- outfile = "" ;
- infiles = [] ;
- current_file = "";
- main_node = "";
- compile_all_items = false;
- run_unit_test = false;
-}
+(* 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 false
+let run_unit_test = ref false
+(* the output channel *)
let oc = ref Pervasives.stdout
+
+
+(* 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 " ^ (Sys.getcwd ()) ^ file ^ "\n");
+ open_in file
+ in
+ line_num := 1;
+ line_start_pos := 0;
+ current_file := file;
+ Lexing.from_channel inchannel
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 5d74ec12..c05d68bb 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 11:52) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 16:50) by Erwan Jahier> *)
open Lxm
@@ -804,25 +804,25 @@ let compile_all_nodes pack_name this id ni_f =
let (compile_all :t -> unit) =
fun this ->
let testpack pack_name = (
- Verbose.printf " * package %s\n" (Ident.pack_name_to_string pack_name);
+ Verbose.printf ~level:3 " * package %s\n" (Ident.pack_name_to_string pack_name);
let prov_symbols =
match SyntaxTab.pack_prov_env this.src_tab pack_name (Lxm.dummy "") with
| Some tab -> tab
| None -> SyntaxTab.pack_body_env this.src_tab pack_name
in
- Verbose.print_string "\tExported types:\n";
+ Verbose.print_string ~level:3 "\tExported types:\n";
SymbolTab.iter_types prov_symbols (compile_all_types pack_name this);
flush stdout;
- Verbose.print_string "\tExported constants:\n";
+ Verbose.print_string ~level:3 "\tExported constants:\n";
SymbolTab.iter_consts prov_symbols (compile_all_constants pack_name this);
flush stdout;
- Verbose.print_string "\tExported nodes:\n";
+ Verbose.print_string ~level:3 "\tExported nodes:\n";
SymbolTab.iter_nodes prov_symbols (compile_all_nodes pack_name this);
flush stdout
)
in
let plist = SyntaxTab.pack_list this.src_tab in
- Verbose.print_string "*** Dump the exported items of the packages.\n";
+ Verbose.print_string ~level:3 "*** Dump the exported items of the packages.\n";
try
List.iter testpack plist
with
diff --git a/src/lxm.ml b/src/lxm.ml
index e6df9487..261a730f 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -1,16 +1,12 @@
-(** Time-stamp: <modified the 30/05/2008 (at 15:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 17:14) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
-(* pour calculer line/col *)
-let line_num = ref 1
-let line_start_pos = ref 0
-
let new_line ( lexbuf ) = (
- line_start_pos := Lexing.lexeme_end lexbuf;
- incr line_num;
- ()
+ Global.line_start_pos := Lexing.lexeme_end lexbuf;
+ incr Global.line_num;
+ ()
)
(* le type ``lexeme'', string + info source *)
@@ -49,11 +45,10 @@ let (flagit : 'a -> t -> 'a srcflagged) =
{ it = x; src = lxm }
-open Global
let dummy str =
{
_str = str ;
- _file = String.concat ", " Global.vars.infiles ;
+ _file = String.concat ", " !Global.infiles ;
_line = 0 ;
_cstart = 0 ;
_cend = 0
@@ -61,15 +56,14 @@ let dummy str =
let last_lexeme = ref (dummy "")
-open Global
let make ( lexbuf ) = (
let s = (Lexing.lexeme lexbuf) in
- let l = !line_num in
- let c1 = (Lexing.lexeme_start lexbuf - !line_start_pos + 1) in
- let c2 = (Lexing.lexeme_end lexbuf - !line_start_pos) in
+ let l = !Global.line_num in
+ let c1 = (Lexing.lexeme_start lexbuf - !Global.line_start_pos + 1) in
+ let c2 = (Lexing.lexeme_end lexbuf - !Global.line_start_pos) in
last_lexeme :=
{ _str = s ;
- _file = Global.vars.current_file;
+ _file = !Global.current_file;
_line = l;
_cstart = c1 ;
_cend = c2
diff --git a/src/main.ml b/src/main.ml
index 5cd22fb0..f34f6d0a 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 16:41) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 17:15) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -48,7 +48,6 @@ open Lxm
open Errors
open Parsing
open Format
-open Global
(*---------------------------------------------------------
@@ -62,60 +61,56 @@ let print_version = function (x: unit) -> (
let usage_msg =
"usage: "^(Version.tool)^" [options] <lustre files> | "^(Version.tool)^" -help"
- let rec set_infile = function (x:string) -> (
- Global.vars.infiles <- Global.vars.infiles@[x]
-
- )
- and arg_list = [
- ( "--version", Arg.Unit(fun x -> print_version () ; exit 0),
- "\tPrint the current version then exit"
- );
- ( "--output-file", Arg.String(fun x -> Global.vars.outfile <- x), "<file>"
- );
- ( "-o", Arg.String(fun x -> Global.vars.outfile <- x),
- "<file>\tSet the output file name"
- );
- ( "--node", Arg.String(fun x -> Global.vars.main_node <- x),
- "<node>"
- );
- ( "-n", Arg.String(fun x -> Global.vars.main_node <- x),
- "<node>\tSet the main node (all items are compiled if unset)"
- );
- ( "--compile-all-items", Arg.Unit
- (function x -> Global.vars.compile_all_items <- true),
- "\t"
- );
- ( "-all", Arg.Unit
- (function x -> Global.vars.compile_all_items <- true),
- "\t\tCompile all items of the program"
- );
- ( "-unit", Arg.Unit (fun x -> Global.vars.run_unit_test <- true),
- "\tRun some (internal) unit tests"
- );
- ( "--verbose", Arg.Unit (fun vl -> Verbose.set_level 1 ),
- ""
- );
- ( "-v", Arg.Unit (fun vl -> Verbose.set_level 1 ),
- "\t\tSet verbose mode on (i.e., verbose level = 1)"
- );
- ( "--verbose-level", Arg.Int(fun vl -> Verbose.set_level vl ), "<int>"
- );
- ( "-vl", Arg.Int(fun vl -> Verbose.set_level vl ),
- "<int>\tSet verbose level"
- );
- ("-h", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)), "" );
- ("-help", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)),"" );
- ("--help", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)),
- "\tDisplay this list of options" )
- ]
- and
- parse_args () = (
- Arg.parse arg_list (* liste des options *)
- set_infile (* arg par defaut = fichier d'entree *)
- usage_msg (* message d'erreur *)
- ;
- ()
- )
+let rec arg_list = [
+ ( "--version", Arg.Unit(fun x -> print_version () ; exit 0),
+ "\tPrint the current version then exit"
+ );
+ ( "--output-file", Arg.String(fun x -> Global.outfile := x), "<file>"
+ );
+ ( "-o", Arg.String(fun x -> Global.outfile := x),
+ "<file>\tSet the output file name"
+ );
+ ( "--node", Arg.String(fun x -> Global.main_node := x),
+ "<node>"
+ );
+ ( "-n", Arg.String(fun x -> Global.main_node := x),
+ "<node>\tSet the main node (all items are compiled if unset)"
+ );
+ ( "--compile-all-items", Arg.Unit
+ (function x -> Global.compile_all_items := true),
+ "\t"
+ );
+ ( "-all", Arg.Unit
+ (function x -> Global.compile_all_items := true),
+ "\t\tCompile all items of the program"
+ );
+ ( "-unit", Arg.Unit (fun x -> Global.run_unit_test := true),
+ "\tRun some (internal) unit tests"
+ );
+ ( "--verbose", Arg.Unit (fun vl -> Verbose.set_level 1 ),
+ ""
+ );
+ ( "-v", Arg.Unit (fun vl -> Verbose.set_level 1 ),
+ "\t\tSet verbose mode on (i.e., verbose level = 1)"
+ );
+ ( "--verbose-level", Arg.Int(fun vl -> Verbose.set_level vl ), "<int>"
+ );
+ ( "-vl", Arg.Int(fun vl -> Verbose.set_level vl ),
+ "<int>\tSet verbose level"
+ );
+ ("-h", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)), "" );
+ ("-help", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)),"" );
+ ("--help", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)),
+ "\tDisplay this list of options" )
+]
+and
+ parse_args () = (
+ Arg.parse arg_list (* liste des options *)
+ Global.add_infile (* arg par defaut = fichier d'entree *)
+ usage_msg (* message d'erreur *)
+ ;
+ ()
+ )
let test_lex ( lexbuf ) = (
let tk = ref (Lexer.lexer lexbuf) in (
@@ -167,12 +162,7 @@ let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
fun infile_list ->
let (get_one_source : string -> string list * maybe_packed) =
fun infile ->
- let inchannel =
- Verbose.print_string ~level:1
- ("Opening file " ^ (Sys.getcwd ()) ^ infile ^ "\n");
- open_in infile in
- let lexbuf = Lexing.from_channel inchannel in
- Global.vars.current_file <- infile;
+ let lexbuf = Global.lexbuf_of_file_name infile in
match (lus_load lexbuf) with
| PRPackBody(incl_files, pbdy) ->
let nme =
@@ -223,26 +213,26 @@ let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
let my_exit i =
close_out !Global.oc;
- if Sys.file_exists Global.vars.outfile then Sys.remove Global.vars.outfile;
+ if Sys.file_exists !Global.outfile then Sys.remove !Global.outfile;
exit i
let main = (
(* Compile.init_appli () ; *)
parse_args ();
- if Global.vars.Global.run_unit_test then (
+ if !Global.run_unit_test then (
Unify.unit_test ()
);
- if (Global.vars.infiles = []) then (
+ if (!Global.infiles = []) then (
Arg.usage arg_list usage_msg ;
exit 1
);
try (
- let nsl = get_source_list Global.vars.infiles in
+ let nsl = get_source_list !Global.infiles in
let main_node =
- if Global.vars.main_node = "" then None else
- Some (Ident.idref_of_string Global.vars.main_node)
+ if !Global.main_node = "" then None else
+ Some (Ident.idref_of_string !Global.main_node)
in
- if Global.vars.outfile <> "" then Global.oc := open_out Global.vars.outfile;
+ if !Global.outfile <> "" then Global.oc := open_out !Global.outfile;
Compile.doit nsl main_node;
close_out !Global.oc
) with
@@ -263,8 +253,8 @@ let main = (
"\n*** oops: an internal error occurred in file "^ file ^ ", line " ^
(string_of_int line) ^ ", column " ^
(string_of_int col) ^ "\n*** when compiling lustre program" ^
- (if List.length Global.vars.infiles > 1 then "s " else " ") ^
- (String.concat ", " Global.vars.infiles) ^ "\n") ;
+ (if List.length !Global.infiles > 1 then "s " else " ") ^
+ (String.concat ", " !Global.infiles) ^ "\n") ;
my_exit 2
(* | Compile_node_error(nkey,lxm,msg) -> ( *)
diff --git a/src/syntaxTab.ml b/src/syntaxTab.ml
index 5d631511..eed13296 100644
--- a/src/syntaxTab.ml
+++ b/src/syntaxTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/05/2008 (at 13:56) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 16:49) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -123,7 +123,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'une const_info *)
let export_const (s:Ident.t) (xci: SyntaxTreeCore.const_info srcflagged) =
- Verbose.printf " export const %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export const %s\n" (Ident.to_string s);
SyntaxTabUtils.put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Ident.make_long pname s) xci.src)
@@ -138,7 +138,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 " export enum const %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export enum const %s\n" (Ident.to_string s);
SyntaxTabUtils.put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Ident.make_long pname s) lxm)
@@ -151,7 +151,7 @@ let init_user_items (this: pack_mng) = (
| ArrayType _
-> ()
);
- Verbose.printf " export type %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export type %s\n" (Ident.to_string s);
SyntaxTabUtils.put_in_tab "type" this.pm_user_items
(TypeItem s)
(Lxm.flagit (Ident.make_long pname s) xti.src)
@@ -159,7 +159,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'un node_info *)
let export_node (s: Ident.t) (xoi: SyntaxTreeCore.node_info srcflagged) =
- Verbose.printf " export node %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export node %s\n" (Ident.to_string s);
SyntaxTabUtils.put_in_tab "node" this.pm_user_items
(NodeItem (s,xoi.it.static_params))
(Lxm.flagit (Ident.make_long pname s) xoi.src)
@@ -238,13 +238,13 @@ let rec (create : SyntaxTree.pack_or_model list -> t) =
st_pack_mng_tab = Hashtbl.create 50;
}
in
- Verbose.printf "*** SyntaxTab.create pass 1\n";
+ Verbose.printf ~level:3 "*** SyntaxTab.create pass 1\n";
(* passe 1 *)
init_raw_tabs res sl ;
(* passe 2 *)
- Verbose.printf "*** SyntaxTab.create pass 2\n";
+ Verbose.printf ~level:3 "*** SyntaxTab.create pass 2\n";
let init_pack_mng pname pdata = (
- Verbose.printf " init pack %s\n" (Ident.pack_name_to_string pname);
+ Verbose.printf ~level:3 " init pack %s\n" (Ident.pack_name_to_string pname);
let pg = ExpandPack.doit res.st_raw_mod_tab pdata in
Hashtbl.add res.st_pack_mng_tab
pname
@@ -252,10 +252,10 @@ let rec (create : SyntaxTree.pack_or_model list -> t) =
) in
Hashtbl.iter init_pack_mng res.st_raw_pack_tab ;
(* passe 3 *)
- Verbose.printf "*** SyntaxTab.create pass 3\n";
+ Verbose.printf ~level:3 "*** SyntaxTab.create pass 3\n";
Hashtbl.iter (init_pack_mng_stabs res) res.st_pack_mng_tab ;
(* resultat *)
- Verbose.printf "*** SyntaxTab.create done\n";
+ Verbose.printf ~level:3 "*** SyntaxTab.create done\n";
res
and
(***** PASSE 1 *****)
@@ -299,7 +299,7 @@ let rec (create : SyntaxTree.pack_or_model list -> t) =
init_pack_mng_stabs (this: t) (pname: Ident.pack_name) (pm: pack_mng) = (
let pg = pm.pm_actual_src in
- Verbose.printf " init symbol tables for pack %s\n"
+ Verbose.printf ~level:3 " init symbol tables for pack %s\n"
(Ident.pack_name_to_string pname);
(* ON COMMENCE PAR TRAITER LE PG_USES *)
let treat_uses (px:Ident.pack_name srcflagged) = (
@@ -388,7 +388,7 @@ let find_node (genv: t) (pck: string) (idr: Ident.t) =
(* exported *)
let (dump : t -> unit) =
fun x ->
- let p = Verbose.print_string in
+ let p = Verbose.print_string ~level:3 in
p "*** « Syntax table dump:\n";
p " \t - Package or model list:\n\t\t";
diff --git a/src/test/should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus b/src/test/should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus
index 0a7ff5dd..8a0dd77e 100644
--- a/src/test/should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus
+++ b/src/test/should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus
@@ -35,17 +35,13 @@ provides
-- isgreaterthan = e1>e2;
--tel
+body
--node _isGreaterOrEqualTo_(e1, e2 : elementType) returns (ge : bool);
--let
-- ge = _isGreaterThan_(e1, e2) or _isEqualTo_(e1, e2);
--tel
-
-
-
-body
-
-- Type fourni: le type "tableau d'éléments elementType"
type arrayType = elementType^size;
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 901b05d9..1a863289 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -13150,7 +13150,7 @@ const intArray__size = 10;
type intArray__arrayType = int^10;
Exported constants:
Exported nodes:
-*** Error in file "should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus", line 257, col 31 to 50, token '_isGreaterOrEqualTo_': unknown node (_isGreaterOrEqualTo_)
+*** Error in file "should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus", line 215, col 31 to 50, token '_isGreaterOrEqualTo_': unknown node (_isGreaterOrEqualTo_)
node util__igt(i:int; j:int) returns (res:bool);
let
--
GitLab