lustrec / src / main_lustre_compiler.ml @ 2823bc51
History | View | Annotate | Download (17.7 KB)
1 | 6efbcb73 | xthirioux | (********************************************************************) |
---|---|---|---|
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 | |||
15 | open Utils |
||
16 | open LustreSpec |
||
17 | open Compiler_common |
||
18 | 04a63d25 | xthirioux | |
19 | exception StopPhase1 of program |
||
20 | 6efbcb73 | xthirioux | |
21 | 04a63d25 | xthirioux | let usage = "Usage: lustrec [options] \x1b[4msource file\x1b[0m" |
22 | 6efbcb73 | xthirioux | |
23 | let extensions = [".ec"; ".lus"; ".lusi"] |
||
24 | |||
25 | (* print a .lusi header file from a source prog *) |
||
26 | let print_lusi prog dirname basename extension = |
||
27 | let header = Lusic.extract_header dirname basename prog in |
||
28 | let header_name = dirname ^ "/" ^ basename ^ extension in |
||
29 | let h_out = open_out header_name in |
||
30 | let h_fmt = formatter_of_out_channel h_out in |
||
31 | begin |
||
32 | 77a61575 | xthirioux | Typing.uneval_prog_generics header; |
33 | Clock_calculus.uneval_prog_generics header; |
||
34 | 6efbcb73 | xthirioux | Printers.pp_lusi_header h_fmt basename header; |
35 | close_out h_out |
||
36 | end |
||
37 | |||
38 | (* compile a .lusi header file *) |
||
39 | let compile_header dirname basename extension = |
||
40 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
41 | let header_name = basename ^ extension in |
||
42 | let lusic_ext = extension ^ "c" in |
||
43 | begin |
||
44 | Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>"); |
||
45 | let header = parse_header true (dirname ^ "/" ^ header_name) in |
||
46 | ignore (Modules.load_header ISet.empty header); |
||
47 | ignore (check_top_decls header); |
||
48 | create_dest_dir (); |
||
49 | Log.report ~level:1 |
||
50 | (fun fmt -> fprintf fmt ".. generating compiled header file %sc@," (destname ^ extension)); |
||
51 | Lusic.write_lusic true header destname lusic_ext; |
||
52 | e70326c9 | ploc | generate_lusic_header destname lusic_ext; |
53 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@ ") |
54 | 6efbcb73 | xthirioux | end |
55 | |||
56 | (* check whether a source file has a compiled header, |
||
57 | if not, generate the compiled header *) |
||
58 | let compile_source_to_header prog computed_types_env computed_clocks_env dirname basename extension = |
||
59 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
60 | let lusic_ext = extension ^ "c" in |
||
61 | let header_name = destname ^ lusic_ext in |
||
62 | begin |
||
63 | if not (Sys.file_exists header_name) then |
||
64 | begin |
||
65 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name); |
||
66 | Lusic.write_lusic false (Lusic.extract_header dirname basename prog) destname lusic_ext; |
||
67 | Lusic.print_lusic_to_h destname lusic_ext |
||
68 | end |
||
69 | else |
||
70 | let lusic = Lusic.read_lusic destname lusic_ext in |
||
71 | if not lusic.Lusic.from_lusi then |
||
72 | begin |
||
73 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name); |
||
74 | Lusic.write_lusic false (Lusic.extract_header dirname basename prog) destname lusic_ext; |
||
75 | 843bc20f | ploc | (*List.iter (fun top_decl -> Format.eprintf "lusic: %a@." Printers.pp_decl top_decl) lusic.Lusic.contents;*) |
76 | 6efbcb73 | xthirioux | Lusic.print_lusic_to_h destname lusic_ext |
77 | end |
||
78 | else |
||
79 | begin |
||
80 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. loading compiled header file %s@," header_name); |
||
81 | a28d1ba7 | xthirioux | Modules.check_dependency lusic destname; |
82 | 6efbcb73 | xthirioux | let header = lusic.Lusic.contents in |
83 | let (declared_types_env, declared_clocks_env) = get_envs_from_top_decls header in |
||
84 | check_compatibility |
||
85 | (prog, computed_types_env, computed_clocks_env) |
||
86 | (header, declared_types_env, declared_clocks_env) |
||
87 | end |
||
88 | end |
||
89 | |||
90 | 843bc20f | ploc | |
91 | 45f0f48d | xthirioux | |
92 | e70326c9 | ploc | let dynamic_checks () = |
93 | match !Options.output, !Options.spec with |
||
94 | | "C", "C" -> true |
||
95 | | _ -> false |
||
96 | |||
97 | 04a63d25 | xthirioux | (* From prog to prog *) |
98 | let stage1 prog dirname basename = |
||
99 | 521e2a6b | ploc | (* Removing automata *) |
100 | 04a63d25 | xthirioux | let prog = expand_automata prog in |
101 | 521e2a6b | ploc | Log.report ~level:4 (fun fmt -> fprintf fmt ".. after automata expansion:@, @[<v 2>@,%a@]@ " Printers.pp_prog prog); |
102 | 60aab16d | xthirioux | |
103 | 6efbcb73 | xthirioux | (* Importing source *) |
104 | let _ = Modules.load_program ISet.empty prog in |
||
105 | |||
106 | (* Extracting dependencies *) |
||
107 | let dependencies, type_env, clock_env = import_dependencies prog in |
||
108 | |||
109 | (* Sorting nodes *) |
||
110 | let prog = SortProg.sort prog in |
||
111 | |||
112 | ec433d69 | xthirioux | (* Perform inlining before any analysis *) |
113 | let orig, prog = |
||
114 | if !Options.global_inline && !Options.main_node <> "" then |
||
115 | (if !Options.witnesses then prog else []), |
||
116 | Inliner.global_inline basename prog type_env clock_env |
||
117 | else (* if !Option.has_local_inline *) |
||
118 | [], |
||
119 | Inliner.local_inline basename prog type_env clock_env |
||
120 | in |
||
121 | |||
122 | (* Checking stateless/stateful status *) |
||
123 | ca88e660 | Ploc | if Plugins.check_force_stateful () then |
124 | 04a63d25 | xthirioux | force_stateful_decls prog |
125 | else |
||
126 | check_stateless_decls prog; |
||
127 | ec433d69 | xthirioux | |
128 | 6efbcb73 | xthirioux | (* Typing *) |
129 | let computed_types_env = type_decls type_env prog in |
||
130 | 45f0f48d | xthirioux | |
131 | 6efbcb73 | xthirioux | (* Clock calculus *) |
132 | let computed_clocks_env = clock_decls clock_env prog in |
||
133 | |||
134 | (* Generating a .lusi header file only *) |
||
135 | if !Options.lusi then |
||
136 | 04a63d25 | xthirioux | (* We stop here the processing and produce the current prog. It will be |
137 | exported as a lusi *) |
||
138 | raise (StopPhase1 prog); |
||
139 | 6efbcb73 | xthirioux | |
140 | 04a63d25 | xthirioux | (* Optimization of prog: |
141 | - Unfold consts |
||
142 | - eliminate trivial expressions |
||
143 | *) |
||
144 | (* |
||
145 | let prog = |
||
146 | if !Options.const_unfold || !Options.optimization >= 5 then |
||
147 | begin |
||
148 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. eliminating constants and aliases@,"); |
||
149 | Optimize_prog.prog_unfold_consts prog |
||
150 | end |
||
151 | else |
||
152 | prog |
||
153 | in |
||
154 | *) |
||
155 | 6efbcb73 | xthirioux | (* Delay calculus *) |
156 | 45f0f48d | xthirioux | (* TO BE DONE LATER (Xavier) |
157 | 6efbcb73 | xthirioux | if(!Options.delay_calculus) |
158 | then |
||
159 | begin |
||
160 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. initialisation analysis@?"); |
||
161 | try |
||
162 | Delay_calculus.delay_prog Basic_library.delay_env prog |
||
163 | with (Delay.Error (loc,err)) as exc -> |
||
164 | Location.print loc; |
||
165 | eprintf "%a" Delay.pp_error err; |
||
166 | Utils.track_exception (); |
||
167 | raise exc |
||
168 | end; |
||
169 | *) |
||
170 | 8deaa2dd | tkahsai | |
171 | 6efbcb73 | xthirioux | (* Creating destination directory if needed *) |
172 | create_dest_dir (); |
||
173 | |||
174 | (* Compatibility with Lusi *) |
||
175 | (* Checking the existence of a lusi (Lustre Interface file) *) |
||
176 | 04a63d25 | xthirioux | let extension = ".lusi" in |
177 | compile_source_to_header prog computed_types_env computed_clocks_env dirname basename extension; |
||
178 | 6efbcb73 | xthirioux | |
179 | Typing.uneval_prog_generics prog; |
||
180 | Clock_calculus.uneval_prog_generics prog; |
||
181 | |||
182 | ec433d69 | xthirioux | if !Options.global_inline && !Options.main_node <> "" && !Options.witnesses then |
183 | begin |
||
184 | let orig = Corelang.copy_prog orig in |
||
185 | e3a4e911 | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating witness file@,"); |
186 | ec433d69 | xthirioux | check_stateless_decls orig; |
187 | let _ = Typing.type_prog type_env orig in |
||
188 | let _ = Clock_calculus.clock_prog clock_env orig in |
||
189 | Typing.uneval_prog_generics orig; |
||
190 | Clock_calculus.uneval_prog_generics orig; |
||
191 | 8deaa2dd | tkahsai | Inliner.witness |
192 | ec433d69 | xthirioux | basename |
193 | !Options.main_node |
||
194 | e3a4e911 | xthirioux | orig prog type_env clock_env |
195 | ec433d69 | xthirioux | end; |
196 | 04a63d25 | xthirioux | |
197 | 6efbcb73 | xthirioux | (* Computes and stores generic calls for each node, |
198 | only useful for ANSI C90 compliant generic node compilation *) |
||
199 | if !Options.ansi then Causality.NodeDep.compute_generic_calls prog; |
||
200 | 04a63d25 | xthirioux | (*Hashtbl.iter (fun id td -> match td.Corelang.top_decl_desc with |
201 | Corelang.Node nd -> Format.eprintf "%s calls %a" id |
||
202 | Causality.NodeDep.pp_generic_calls nd | _ -> ()) Corelang.node_table;*) |
||
203 | 6efbcb73 | xthirioux | |
204 | e70326c9 | ploc | (* If some backend involving dynamic checks are active, then node annotations become runtime checks *) |
205 | let prog = |
||
206 | if dynamic_checks () then |
||
207 | Spec.enforce_spec_prog prog |
||
208 | else |
||
209 | prog |
||
210 | in |
||
211 | |||
212 | 6efbcb73 | xthirioux | (* Normalization phase *) |
213 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,"); |
||
214 | 27dc3869 | ploc | let prog = Normalization.normalize_prog ~backend:!Options.output prog in |
215 | 04a63d25 | xthirioux | Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
216 | fc886259 | xthirioux | |
217 | 04a63d25 | xthirioux | let prog = |
218 | if !Options.mpfr |
||
219 | then |
||
220 | begin |
||
221 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. targetting MPFR library@,"); |
||
222 | Mpfr.inject_prog prog |
||
223 | end |
||
224 | else |
||
225 | begin |
||
226 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. keeping floating-point numbers@,"); |
227 | 04a63d25 | xthirioux | prog |
228 | end in |
||
229 | 6efbcb73 | xthirioux | Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
230 | 04a63d25 | xthirioux | |
231 | 6efbcb73 | xthirioux | (* Checking array accesses *) |
232 | if !Options.check then |
||
233 | begin |
||
234 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. checking array accesses@,"); |
235 | 6efbcb73 | xthirioux | Access.check_prog prog; |
236 | end; |
||
237 | |||
238 | 04a63d25 | xthirioux | prog, dependencies |
239 | |||
240 | (* from source to machine code, with optimization *) |
||
241 | let stage2 prog = |
||
242 | 6efbcb73 | xthirioux | (* Computation of node equation scheduling. It also breaks dependency cycles |
243 | and warns about unused input or memory variables *) |
||
244 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,"); |
||
245 | let prog, node_schs = Scheduling.schedule_prog prog in |
||
246 | 04a63d25 | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt "%a" Scheduling.pp_warning_unused node_schs); |
247 | 6efbcb73 | xthirioux | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs); |
248 | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs); |
||
249 | 04a63d25 | xthirioux | Log.report ~level:5 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_dep_graph node_schs); |
250 | 6efbcb73 | xthirioux | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
251 | |||
252 | 04a63d25 | xthirioux | |
253 | (* TODO Salsa optimize prog: |
||
254 | - emits warning for programs with pre inside expressions |
||
255 | - make sure each node arguments and memory is bounded by a local annotation |
||
256 | - introduce fresh local variables for each real pure subexpression |
||
257 | *) |
||
258 | 6efbcb73 | xthirioux | (* DFS with modular code generation *) |
259 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,"); |
260 | 6efbcb73 | xthirioux | let machine_code = Machine_code.translate_prog prog node_schs in |
261 | |||
262 | 521e2a6b | ploc | Log.report ~level:3 (fun fmt -> fprintf fmt ".. generated machines (unoptimized):@ %a@ "Machine_code.pp_machines machine_code); |
263 | 2d179f5b | xthirioux | |
264 | 6efbcb73 | xthirioux | (* Optimize machine code *) |
265 | let machine_code = |
||
266 | cf9cc6f9 | Ploc | if !Options.optimization >= 4 (* && !Options.output <> "horn" *) then |
267 | c287ba28 | xthirioux | begin |
268 | cf9cc6f9 | Ploc | Log.report ~level:1 |
269 | (fun fmt -> fprintf fmt ".. machines optimization: sub-expression elimination@,"); |
||
270 | 521e2a6b | ploc | let machine_code = Optimize_machine.machines_cse machine_code in |
271 | Log.report ~level:3 (fun fmt -> fprintf fmt ".. generated machines (sub-expr elim):@ %a@ "Machine_code.pp_machines machine_code); |
||
272 | machine_code |
||
273 | c287ba28 | xthirioux | end |
274 | else |
||
275 | machine_code |
||
276 | in |
||
277 | (* Optimize machine code *) |
||
278 | 04a63d25 | xthirioux | let machine_code, removed_table = |
279 | ca88e660 | Ploc | if !Options.optimization >= 2 (*&& !Options.output <> "horn"*) then |
280 | 6efbcb73 | xthirioux | begin |
281 | ca88e660 | Ploc | Log.report ~level:1 (fun fmt -> fprintf fmt |
282 | 521e2a6b | ploc | ".. machines optimization: const. inlining (partial eval. with const)@,"); |
283 | let machine_code, removed_table = Optimize_machine.machines_unfold (Corelang.get_consts prog) node_schs machine_code in |
||
284 | Log.report ~level:3 (fun fmt -> fprintf fmt "\t@[Eliminated constants: @[%a@]@]@ " |
||
285 | (pp_imap Optimize_machine.pp_elim) removed_table); |
||
286 | Log.report ~level:3 (fun fmt -> fprintf fmt ".. generated machines (const inlining):@ %a@ "Machine_code.pp_machines machine_code); |
||
287 | machine_code, removed_table |
||
288 | 6efbcb73 | xthirioux | end |
289 | else |
||
290 | 04a63d25 | xthirioux | machine_code, IMap.empty |
291 | in |
||
292 | 6efbcb73 | xthirioux | (* Optimize machine code *) |
293 | 85da3a4b | ploc | let machine_code = |
294 | if !Options.optimization >= 3 && not (Corelang.functional_backend ()) then |
||
295 | 6efbcb73 | xthirioux | begin |
296 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: minimize stack usage by reusing variables@,"); |
297 | 04a63d25 | xthirioux | let node_schs = Scheduling.remove_prog_inlined_locals removed_table node_schs in |
298 | let reuse_tables = Scheduling.compute_prog_reuse_table node_schs in |
||
299 | Optimize_machine.machines_fusion (Optimize_machine.machines_reuse_variables machine_code reuse_tables) |
||
300 | 6efbcb73 | xthirioux | end |
301 | else |
||
302 | machine_code |
||
303 | ec433d69 | xthirioux | in |
304 | 04a63d25 | xthirioux | |
305 | (* Salsa optimize machine code *) |
||
306 | (* |
||
307 | let machine_code = |
||
308 | if !Options.salsa_enabled then |
||
309 | begin |
||
310 | check_main (); |
||
311 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. salsa machines optimization: optimizing floating-point accuracy with Salsa@,"); |
312 | 04a63d25 | xthirioux | (* Selecting float constants for Salsa *) |
313 | let constEnv = List.fold_left ( |
||
314 | fun accu c_topdecl -> |
||
315 | match c_topdecl.top_decl_desc with |
||
316 | | Const c when Types.is_real_type c.const_type -> |
||
317 | (c.const_id, c.const_value) :: accu |
||
318 | | _ -> accu |
||
319 | ) [] (Corelang.get_consts prog) |
||
320 | in |
||
321 | List.map |
||
322 | (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) |
||
323 | machine_code |
||
324 | end |
||
325 | else |
||
326 | machine_code |
||
327 | in |
||
328 | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@ " |
||
329 | (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine) |
||
330 | machine_code); |
||
331 | *) |
||
332 | machine_code |
||
333 | c287ba28 | xthirioux | |
334 | 8deaa2dd | tkahsai | |
335 | 04a63d25 | xthirioux | (* printing code *) |
336 | let stage3 prog machine_code dependencies basename = |
||
337 | 6efbcb73 | xthirioux | let basename = Filename.basename basename in |
338 | 04a63d25 | xthirioux | match !Options.output with |
339 | dc893173 | ploc | "C" -> |
340 | 6efbcb73 | xthirioux | begin |
341 | dc893173 | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,"); |
342 | C_backend.translate_to_c |
||
343 | (* alloc_header_file source_lib_file source_main_file makefile_file *) |
||
344 | basename prog machine_code dependencies |
||
345 | 6efbcb73 | xthirioux | end |
346 | dc893173 | ploc | | "java" -> |
347 | begin |
||
348 | (Format.eprintf "internal error: sorry, but not yet supported !"; assert false) |
||
349 | (*let source_file = basename ^ ".java" in |
||
350 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. opening file %s@,@?" source_file); |
||
351 | let source_out = open_out source_file in |
||
352 | let source_fmt = formatter_of_out_channel source_out in |
||
353 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?"); |
||
354 | Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*) |
||
355 | end |
||
356 | | "horn" -> |
||
357 | begin |
||
358 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
359 | let source_file = destname ^ ".smt2" in (* Could be changed *) |
||
360 | let source_out = open_out source_file in |
||
361 | let fmt = formatter_of_out_channel source_out in |
||
362 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. hornification@,"); |
||
363 | Horn_backend.translate fmt basename prog (Machine_code.arrow_machine::machine_code); |
||
364 | (* Tracability file if option is activated *) |
||
365 | if !Options.traces then ( |
||
366 | let traces_file = destname ^ ".traces.xml" in (* Could be changed *) |
||
367 | let traces_out = open_out traces_file in |
||
368 | let fmt = formatter_of_out_channel traces_out in |
||
369 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. tracing info@,"); |
||
370 | Horn_backend_traces.traces_file fmt basename prog machine_code; |
||
371 | ) |
||
372 | end |
||
373 | | "lustre" -> |
||
374 | begin |
||
375 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
376 | let source_file = destname ^ ".lustrec.lus" in (* Could be changed *) |
||
377 | let source_out = open_out source_file in |
||
378 | let fmt = formatter_of_out_channel source_out in |
||
379 | Printers.pp_prog fmt prog; |
||
380 | (* Lustre_backend.translate fmt basename normalized_prog machine_code *) |
||
381 | () |
||
382 | end |
||
383 | a6df3992 | Ploc | | "emf" -> |
384 | begin |
||
385 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
386 | let source_file = destname ^ ".emf" in (* Could be changed *) |
||
387 | let source_out = open_out source_file in |
||
388 | let fmt = formatter_of_out_channel source_out in |
||
389 | 3ca27bc7 | ploc | EMF_backend.translate fmt basename prog machine_code; |
390 | a6df3992 | Ploc | () |
391 | end |
||
392 | dc893173 | ploc | |
393 | | _ -> assert false |
||
394 | 04a63d25 | xthirioux | |
395 | (* compile a .lus source file *) |
||
396 | let rec compile_source dirname basename extension = |
||
397 | let source_name = dirname ^ "/" ^ basename ^ extension in |
||
398 | |||
399 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>"); |
400 | 04a63d25 | xthirioux | |
401 | (* Parsing source *) |
||
402 | let prog = parse_source source_name in |
||
403 | |||
404 | let prog = |
||
405 | if !Options.mpfr then |
||
406 | Mpfr.mpfr_module::prog |
||
407 | else |
||
408 | prog |
||
409 | in |
||
410 | let prog, dependencies = |
||
411 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. Phase 1 : Normalisation@,"); |
412 | 04a63d25 | xthirioux | try |
413 | stage1 prog dirname basename |
||
414 | with StopPhase1 prog -> ( |
||
415 | if !Options.lusi then |
||
416 | begin |
||
417 | let lusi_ext = extension ^ "i" in |
||
418 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating interface file %s@ " (basename ^ lusi_ext)); |
419 | 04a63d25 | xthirioux | print_lusi prog dirname basename lusi_ext; |
420 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@."); |
||
421 | exit 0 |
||
422 | end |
||
423 | else |
||
424 | assert false |
||
425 | ) |
||
426 | 6efbcb73 | xthirioux | in |
427 | 521e2a6b | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt "@]@,"); |
428 | Log.report ~level:3 (fun fmt -> fprintf fmt ".. Normalized program:@ %a@ "Printers.pp_prog prog); |
||
429 | |||
430 | Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. Phase 2 : Machines generation@,"); |
||
431 | 04a63d25 | xthirioux | |
432 | let machine_code = |
||
433 | stage2 prog |
||
434 | in |
||
435 | 521e2a6b | ploc | |
436 | Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ "); |
||
437 | Log.report ~level:3 (fun fmt -> fprintf fmt ".. Generated machines:@ %a@ "Machine_code.pp_machines machine_code); |
||
438 | |||
439 | 04a63d25 | xthirioux | if Scopes.Plugin.show_scopes () then |
440 | begin |
||
441 | let all_scopes = Scopes.compute_scopes prog !Options.main_node in |
||
442 | (* Printing scopes *) |
||
443 | if !Options.verbose_level >= 1 then |
||
444 | Format.printf "Possible scopes are:@ "; |
||
445 | 521e2a6b | ploc | Format.printf "@[<v>%a@ @]@ @?" Scopes.print_scopes all_scopes; |
446 | 04a63d25 | xthirioux | exit 0 |
447 | |||
448 | end; |
||
449 | |||
450 | ca88e660 | Ploc | let machine_code = Plugins.refine_machine_code prog machine_code in |
451 | 04a63d25 | xthirioux | |
452 | stage3 prog machine_code dependencies basename; |
||
453 | f4acee4c | xthirioux | begin |
454 | ca88e660 | Ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@."); |
455 | 04a63d25 | xthirioux | (* We stop the process here *) |
456 | f4acee4c | xthirioux | exit 0 |
457 | end |
||
458 | 6efbcb73 | xthirioux | |
459 | let compile dirname basename extension = |
||
460 | match extension with |
||
461 | | ".lusi" -> compile_header dirname basename extension |
||
462 | | ".lus" -> compile_source dirname basename extension |
||
463 | | _ -> assert false |
||
464 | |||
465 | let anonymous filename = |
||
466 | let ok_ext, ext = List.fold_left |
||
467 | (fun (ok, ext) ext' -> |
||
468 | if not ok && Filename.check_suffix filename ext' then |
||
469 | true, ext' |
||
470 | else |
||
471 | ok, ext) |
||
472 | (false, "") extensions in |
||
473 | if ok_ext then |
||
474 | let dirname = Filename.dirname filename in |
||
475 | let basename = Filename.chop_suffix (Filename.basename filename) ext in |
||
476 | compile dirname basename ext |
||
477 | else |
||
478 | raise (Arg.Bad ("Can only compile *.lusi, *.lus or *.ec files")) |
||
479 | |||
480 | let _ = |
||
481 | 04a63d25 | xthirioux | Global.initialize (); |
482 | 6efbcb73 | xthirioux | Corelang.add_internal_funs (); |
483 | try |
||
484 | Printexc.record_backtrace true; |
||
485 | 04a63d25 | xthirioux | |
486 | 1bff14ac | ploc | let options = Options_management.lustrec_options @ (Plugins.options ()) in |
487 | 04a63d25 | xthirioux | |
488 | Arg.parse options anonymous usage |
||
489 | 6efbcb73 | xthirioux | with |
490 | 04a63d25 | xthirioux | | Parse.Error _ |
491 | 6efbcb73 | xthirioux | | Types.Error (_,_) | Clocks.Error (_,_) |
492 | | Corelang.Error _ (*| Task_set.Error _*) |
||
493 | eb837d74 | xthirioux | | Causality.Error _ -> exit 1 |
494 | 6efbcb73 | xthirioux | | Sys_error msg -> (eprintf "Failure: %s@." msg) |
495 | 990210f3 | ploc | | exc -> (track_exception (); raise exc) |
496 | 6efbcb73 | xthirioux | |
497 | (* Local Variables: *) |
||
498 | (* compile-command:"make -C .." *) |
||
499 | (* End: *) |