-
Erwan Jahier authoredErwan Jahier authored
main.ml 10.84 KiB
(** Time-stamp: <modified the 19/01/2010 (at 15:49) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
(1) First of all, the Lustre files are parsed,
lexer.mll
parser.mly
parserUtils.ml
lxm.mli/ml
which results into a parse tree containing raw source expressions.
syntaxTree.ml -> should rather be called rawSyntaxTab.ml ?
(2) Then, we perform reference checking at module level + model expansion.
syntaxTab.mli/ml
syntaxTabUtil.ml/mli
instanciateModel.mli/ml
symbolTab.mli/ml (type/const/node)
syntaxTab is a kind of layer above syntaxTree to make things easier afterwards.
(3) Finally, the compilation (type checking+const/type evaluation) is performed.
compile.ml
lazyCompiler.mli/ml
evalConst.mli/ml
evalType.mli/ml
compiledData.ml
Some misc (eponymous) modules are used along the way.
errors.ml
verbose.mli/ml
version.ml
ident.ml
*)
open Verbose
open SyntaxTree
open SyntaxTreeCore
open Lxm
open Errors
open Parsing
open Format
(*---------------------------------------------------------
Les args sont des variables GLOBALES
---------------------------------------------------------*)
let print_version = function (x: unit) -> (
print_string (Version.str ^ "\n")
)
let usage_msg =
"usage: "^(Version.tool)^" [options] <lustre files>\nwhere [options] can be:"
let rec arg_list = [
( "--node", Arg.String(fun x -> Global.main_node := x; Global.compile_all_items := false),
"<node>"
);
( "-n", Arg.String(fun x -> Global.main_node := x; Global.compile_all_items := false),
"<node>\n\t Set the main node (all items are compiled if unset)"
);
( "--output-file", Arg.String(fun x -> Global.outfile := x), "<file>"
);
( "-o", Arg.String(fun x -> Global.outfile := x),
"<file>\n\t Set the output file name."
);
( "--keep-nested-calls", Arg.Unit (fun _ -> Global.one_op_per_equation := false),
""
);
( "-knc", Arg.Unit (fun _ -> Global.one_op_per_equation := false),
"\n\t Keep nested calls. By default, only one node per equation is generated."
);
( "--expand-iterators", Arg.Unit (fun _ -> Global.inline_iterator := true),
""
);
( "-ei", Arg.Unit (fun _ -> Global.inline_iterator := true),
"\n\t Expand array iterators."
);
( "--expand-enums", Arg.Unit (fun _ -> Global.expand_enums := true),
""
);
( "-ee", Arg.Unit (fun _ -> Global.expand_enums := true),
"\n\t Translate enums into integers."
);
( "--expand-structs-and-arrays", Arg.Unit
(fun _ -> Global.expand_structs := true;Global.inline_iterator := true),
""
);
( "-esa", Arg.Unit
(fun _ -> Global.expand_structs := true;Global.inline_iterator := true),
"\n\t Expand structures and arrays using as many variables as necessary (automatically impose '-ei')."
);
( "--expand-nodes", Arg.Unit (fun _ -> Global.expand_nodes := true),
""
);
( "-en", Arg.Unit (fun _ -> Global.expand_nodes := true),
"\n\t Expand the main node (use the first node if no one is specified)."
);
( "--do-not-expand-node", Arg.String add_dont_expand_nodes,
"<node>"
);
( "-den", Arg.String add_dont_expand_nodes,
"<node>\n\t Do not expand node (useful in the expand mode only of course)."
);
( "--lustre-v4", Arg.Unit
(fun _ -> set_v4_options ()),
"\t"
);
( "-lv4", Arg.Unit
(fun _ -> set_v4_options ()),
"\n\t Use Lustre V4 syntax (automatically impose '-ei -ee -esa')."
);
( "--expanded-code", Arg.Unit
(fun _ -> set_ec_options ()),
""
);
( "-ec", Arg.Unit
(fun _ -> set_ec_options ()),
"\n\t Generate ec (actually just an alias for '-en -lv4')."
);
( "-unit", Arg.Unit (fun x -> Global.run_unit_test := true),
"\n\t Run some (internal) unit tests"
);
( "--verbose-level", Arg.Int(fun vl -> Verbose.set_level vl ), "<int>"
);
( "-vl", Arg.Int(fun vl -> Verbose.set_level vl ),
"<int>\n\t Set the verbose level."
);
( "--verbose", Arg.Unit (fun vl -> Verbose.set_level 1 ),
""
);
( "-v", Arg.Unit (fun vl -> Verbose.set_level 1 ),
"\n\t Set the verbose level to 1."
);
( "--version", Arg.Unit(fun x -> print_version () ; exit 0),
""
);
( "-version", Arg.Unit(fun x -> print_version () ; exit 0),
"\n\t Display the current version of the tool."
);
("-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)),
"\n\t Display this message." )
]
and set_v4_options () =
Global.lv4 := true;
Global.inline_iterator := true;
Global.expand_enums := true;
Global.expand_structs := true
and set_ec_options () =
set_v4_options ();
Global.ec := true;
Global.expand_nodes := true
and add_dont_expand_nodes str =
Global.dont_expand_nodes := str::!Global.dont_expand_nodes
and
parse_args () = (
Arg.parse arg_list (* liste des options *)
Global.add_infile (* arg par defaut = fichier d'entree *)
usage_msg (* message d'erreur *)
;
()
)
(* Retourne un parse_tree *)
let lus_load lexbuf = (
SolveIdent.recognize_predef_op
(Parser.sxLusFile Lexer.lexer lexbuf)
)
(*
Lance le parser et renvoie la liste name-spaces d'entre.
Dans le cas d'un fichier sans package, on lui donne
comme nom le basename de infile.
*)
type maybe_packed =
| Packed of SyntaxTree.pack_or_model list
| Unpacked of SyntaxTree.pack_or_model
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 lexbuf = Global.lexbuf_of_file_name infile in
match (lus_load lexbuf) with
| PRPackBody(incl_files, pbdy) ->
let nme =
try Filename.chop_extension (Filename.basename infile)
with _ ->
print_string ("*** '"^infile^"': bad file name.\n"); exit 1
in
let pi =
SyntaxTree.give_pack_this_name (Ident.pack_name_of_string nme) pbdy
in
incl_files, Unpacked (NSPack (Lxm.flagit pi (Lxm.dummy nme)))
| PRPack_or_models(incl_files, nsl) -> incl_files, Packed nsl
in
let rec (get_remaining_source_list : maybe_packed * string list * string list ->
maybe_packed * string list * string list) =
fun (maybe_pack, compiled, to_be_compiled) ->
match to_be_compiled with
| [] -> (maybe_pack, compiled, [])
| infile::tail ->
if List.mem infile compiled then
get_remaining_source_list (maybe_pack, compiled, tail)
else let included_files, pack = get_one_source infile in
let new_maybe_pack =
match maybe_pack, pack with
| Unpacked _, _
| _, Unpacked _ ->
print_string ("old-style (un-packaged) lustre files can " ^
" not be mixed with packages, nor be " ^
" defined in more than 1 file.");
exit 1
| Packed l1, Packed l2 -> Packed (l1@l2)
in
get_remaining_source_list(
new_maybe_pack,
infile::compiled,
tail@included_files)
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,_,_) = get_remaining_source_list
(first_pack, [first_file], (List.tl infile_list) @ included_files)
in
match pack_list with
| Packed l -> l
| Unpacked pack -> [pack]
let dump_entete oc =
let time = Unix.localtime (Unix.time ()) in
let sys_call, _ = Array.fold_left
(fun (acc,i) x ->
if 70 < i + (String.length x) then
acc ^ "\n--\t\t" ^ x, String.length ("\n--\t\t" ^ x)
else
acc ^ " " ^ x , (i+1+(String.length x))
)
("",0)
Sys.argv
and
date = (
(string_of_int time.Unix.tm_mday) ^ "/" ^
(string_of_int (time.Unix.tm_mon+1)) ^ "/" ^
(string_of_int (1900+time.Unix.tm_year))
)
and time_str = (
(string_of_int time.Unix.tm_hour) ^ ":" ^ (if time.Unix.tm_min < 10 then "0" else "") ^
(string_of_int time.Unix.tm_min) ^ ":" ^
(if time.Unix.tm_sec < 10 then "0" else "") ^
(string_of_int time.Unix.tm_sec)
)
(* and user = Unix.getlogin () *)
and hostname = Unix.gethostname ()
in
output_string oc
("-- This file was generated by lus2lic version " ^ Version.str ^
".\n--\t" ^ sys_call ^ "
-- on " ^ hostname ^
(* "by "^ user ^ *)
" the " ^ date ^ " at " ^ time_str ^ "\n\n");
flush oc
let my_exit i =
close_out !Global.oc;
if Sys.file_exists !Global.outfile then Sys.remove !Global.outfile;
exit i
let main = (
(* Compile.init_appli () ; *)
parse_args ();
if Verbose.get_level() > 2 then Gc.set { (Gc.get ()) with Gc.verbose = 0x01 };
if !Global.run_unit_test then (
UnifyType.unit_test ();
exit 0
);
if (!Global.infiles = []) then (
Arg.usage arg_list usage_msg ;
exit 1
);
try (
let nsl = get_source_list !Global.infiles in
let main_node =
if !Global.main_node = "" then None else
Some (Ident.idref_of_string !Global.main_node)
in
if !Global.outfile <> "" then Global.oc := open_out !Global.outfile;
dump_entete !Global.oc;
Compile.doit nsl main_node;
LicDump.dump_type_alias !Global.oc;
if Verbose.get_level() > 2 then Gc.print_stat stdout;
close_out !Global.oc
) with
Sys_error(s) ->
prerr_string (s^"\n");
my_exit 1
| Global_error s ->
print_global_error s ;
my_exit 1
| Parse_error ->
print_compile_error (Lxm.last_made ()) "syntax error";
my_exit 1
| Compile_error(lxm,msg) ->
print_compile_error lxm msg ;
my_exit 1
| Assert_failure (file, line, col) ->
prerr_string (
"\n*** oops: an internal error (lus2lic) occurred in file "^ 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"^
"\n*** You migth want to sent a bug report to jahier@imag.fr\n") ;
my_exit 2
(* | Compile_node_error(nkey,lxm,msg) -> ( *) (* print_compile_node_error nkey lxm msg ; *)
(* exit 1 *)
(* ) *)
(* | Global_node_error(nkey,msg) -> ( *)
(* print_global_node_error nkey msg ; *)
(* exit 1 *)
(* ) *)
)