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