lustrec / src / main_lustre_compiler.ml @ a0c92fa8
History | View | Annotate | Download (4.96 KB)
1 |
(********************************************************************) |
---|---|
2 |
(* *) |
3 |
(* The LustreC compiler toolset / The LustreC Development Team *) |
4 |
(* Copyright 2012 - -- ONERA - CNRS - INPT *) |
5 |
(* *) |
6 |
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
7 |
(* under the terms of the GNU Lesser General Public License *) |
8 |
(* version 2.1. *) |
9 |
(* *) |
10 |
(********************************************************************) |
11 |
|
12 |
open Format |
13 |
open Log |
14 |
open Compiler_common |
15 |
|
16 |
open Utils |
17 |
open Lustre_types |
18 |
|
19 |
|
20 |
let usage = "Usage: lustrec [options] \x1b[4msource file\x1b[0m" |
21 |
|
22 |
let extensions = [".ec"; ".lus"; ".lusi"] |
23 |
|
24 |
(* print a .lusi header file from a source prog *) |
25 |
let print_lusi prog dirname basename extension = |
26 |
let header = Lusic.extract_header dirname basename prog in |
27 |
let header_name = dirname ^ "/" ^ basename ^ extension in |
28 |
let h_out = open_out header_name in |
29 |
let h_fmt = formatter_of_out_channel h_out in |
30 |
begin |
31 |
Typing.uneval_prog_generics header; |
32 |
Clock_calculus.uneval_prog_generics header; |
33 |
Printers.pp_lusi_header h_fmt basename header; |
34 |
close_out h_out |
35 |
end |
36 |
|
37 |
|
38 |
|
39 |
|
40 |
|
41 |
|
42 |
(* compile a .lus source file *) |
43 |
let rec compile dirname basename extension = |
44 |
let source_name = dirname ^ "/" ^ basename ^ extension in |
45 |
|
46 |
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>"); |
47 |
|
48 |
(* Parsing source *) |
49 |
let prog = parse source_name extension in |
50 |
|
51 |
let prog = |
52 |
if !Options.mpfr && |
53 |
extension = ".lus" (* trying to avoid the injection of the module for lusi files *) |
54 |
then |
55 |
Mpfr.mpfr_module::prog |
56 |
else |
57 |
prog |
58 |
in |
59 |
let params = Backends.get_normalization_params () in |
60 |
|
61 |
let prog, dependencies = |
62 |
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. Phase 1 : Normalisation@,"); |
63 |
try |
64 |
Compiler_stages.stage1 params prog dirname basename extension |
65 |
with Compiler_stages.StopPhase1 prog -> ( |
66 |
if !Options.lusi then |
67 |
begin |
68 |
let lusi_ext = extension ^ "i" in |
69 |
Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating interface file %s@ " (basename ^ lusi_ext)); |
70 |
print_lusi prog dirname basename lusi_ext; |
71 |
Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@."); |
72 |
exit 0 |
73 |
end |
74 |
else if !Options.print_nodes then ( |
75 |
Format.printf "%a@.@?" Printers.pp_node_list prog; |
76 |
exit 0 |
77 |
) |
78 |
else |
79 |
assert false |
80 |
) |
81 |
in |
82 |
Log.report ~level:3 (fun fmt -> fprintf fmt ".. Normalized program:@ %a@ "Printers.pp_prog prog); |
83 |
Log.report ~level:1 (fun fmt -> fprintf fmt "@]@,"); |
84 |
|
85 |
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. Phase 2 : Machines generation@,"); |
86 |
|
87 |
let prog, machine_code = |
88 |
Compiler_stages.stage2 params prog |
89 |
in |
90 |
|
91 |
Log.report ~level:3 (fun fmt -> fprintf fmt ".. Generated machines:@ %a@ " Machine_code_common.pp_machines machine_code); |
92 |
|
93 |
if Scopes.Plugin.show_scopes () then |
94 |
begin |
95 |
let all_scopes = Scopes.compute_scopes prog !Options.main_node in |
96 |
(* Printing scopes *) |
97 |
if !Options.verbose_level >= 1 then |
98 |
Format.printf "Possible scopes are:@ "; |
99 |
Format.printf "@[<v>%a@ @]@ @?" Scopes.print_scopes all_scopes; |
100 |
exit 0 |
101 |
|
102 |
end; |
103 |
let machine_code = Plugins.refine_machine_code prog machine_code in |
104 |
Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ @ "); |
105 |
|
106 |
Compiler_stages.stage3 prog machine_code dependencies basename extension; |
107 |
begin |
108 |
Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@."); |
109 |
(* We stop the process here *) |
110 |
exit 0 |
111 |
end |
112 |
|
113 |
let compile dirname basename extension = |
114 |
Plugins.init (); |
115 |
match extension with |
116 |
| ".lusi" |
117 |
| ".lus" -> compile dirname basename extension |
118 |
| _ -> assert false |
119 |
|
120 |
let anonymous filename = |
121 |
let ok_ext, ext = List.fold_left |
122 |
(fun (ok, ext) ext' -> |
123 |
if not ok && Filename.check_suffix filename ext' then |
124 |
true, ext' |
125 |
else |
126 |
ok, ext) |
127 |
(false, "") extensions in |
128 |
if ok_ext then |
129 |
let dirname = Filename.dirname filename in |
130 |
let basename = Filename.chop_suffix (Filename.basename filename) ext in |
131 |
compile dirname basename ext |
132 |
else |
133 |
raise (Arg.Bad ("Can only compile *.lusi, *.lus or *.ec files")) |
134 |
|
135 |
let _ = |
136 |
Global.initialize (); |
137 |
Corelang.add_internal_funs (); |
138 |
try |
139 |
Printexc.record_backtrace true; |
140 |
|
141 |
let options = Options_management.lustrec_options @ (Plugins.options ()) in |
142 |
|
143 |
Arg.parse options anonymous usage |
144 |
with |
145 |
| Parse.Error _ |
146 |
| Types.Error (_,_) | Clocks.Error (_,_) -> exit 1 |
147 |
| Error.Error (loc , kind) (*| Task_set.Error _*) -> |
148 |
Error.pp_error loc (fun fmt -> Error.pp_error_msg fmt kind); |
149 |
exit (Error.return_code kind) |
150 |
(* | Causality.Error _ -> exit (Error.return_code Error.AlgebraicLoop) *) |
151 |
| Sys_error msg -> (eprintf "Failure: %s@." msg); exit 1 |
152 |
| exc -> (track_exception (); raise exc) |
153 |
|
154 |
(* Local Variables: *) |
155 |
(* compile-command:"make -C .." *) |
156 |
(* End: *) |