lustrec / src / main_lustre_compiler.ml @ a6df3992
History | View | Annotate | Download (16.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 | Lusic.print_lusic_to_h destname lusic_ext; |
||
53 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@.") |
||
54 | 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 | let functional_backend () = |
92 | match !Options.output with |
||
93 | a6df3992 | Ploc | | "horn" | "lustre" | "emf" | "acsl" -> true |
94 | 45f0f48d | xthirioux | | _ -> false |
95 | |||
96 | 04a63d25 | xthirioux | (* From prog to prog *) |
97 | let stage1 prog dirname basename = |
||
98 | (* Removing automata *) |
||
99 | let prog = expand_automata prog in |
||
100 | 843bc20f | ploc | |
101 | 04a63d25 | xthirioux | 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 | 04a63d25 | xthirioux | if Scopes.Plugin.is_active () then |
124 | 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 | (* Normalization phase *) |
||
205 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,"); |
||
206 | (* Special treatment of arrows in lustre backend. We want to keep them *) |
||
207 | if !Options.output = "lustre" then |
||
208 | Normalization.unfold_arrow_active := false; |
||
209 | let prog = Normalization.normalize_prog prog in |
||
210 | 04a63d25 | xthirioux | Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
211 | fc886259 | xthirioux | |
212 | 04a63d25 | xthirioux | let prog = |
213 | if !Options.mpfr |
||
214 | then |
||
215 | begin |
||
216 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. targetting MPFR library@,"); |
||
217 | Mpfr.inject_prog prog |
||
218 | end |
||
219 | else |
||
220 | begin |
||
221 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. keeping floating-point numbers@,"); |
222 | 04a63d25 | xthirioux | prog |
223 | end in |
||
224 | 6efbcb73 | xthirioux | Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
225 | 04a63d25 | xthirioux | |
226 | 6efbcb73 | xthirioux | (* Checking array accesses *) |
227 | if !Options.check then |
||
228 | begin |
||
229 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. checking array accesses@,"); |
230 | 6efbcb73 | xthirioux | Access.check_prog prog; |
231 | end; |
||
232 | |||
233 | 04a63d25 | xthirioux | prog, dependencies |
234 | |||
235 | (* from source to machine code, with optimization *) |
||
236 | let stage2 prog = |
||
237 | 6efbcb73 | xthirioux | (* Computation of node equation scheduling. It also breaks dependency cycles |
238 | and warns about unused input or memory variables *) |
||
239 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,"); |
||
240 | let prog, node_schs = Scheduling.schedule_prog prog in |
||
241 | 04a63d25 | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt "%a" Scheduling.pp_warning_unused node_schs); |
242 | 6efbcb73 | xthirioux | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs); |
243 | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs); |
||
244 | 04a63d25 | xthirioux | Log.report ~level:5 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_dep_graph node_schs); |
245 | 6efbcb73 | xthirioux | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog); |
246 | |||
247 | 04a63d25 | xthirioux | |
248 | (* TODO Salsa optimize prog: |
||
249 | - emits warning for programs with pre inside expressions |
||
250 | - make sure each node arguments and memory is bounded by a local annotation |
||
251 | - introduce fresh local variables for each real pure subexpression |
||
252 | *) |
||
253 | 6efbcb73 | xthirioux | (* DFS with modular code generation *) |
254 | 04a63d25 | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@ "); |
255 | 6efbcb73 | xthirioux | let machine_code = Machine_code.translate_prog prog node_schs in |
256 | |||
257 | 04a63d25 | xthirioux | Log.report ~level:4 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," |
258 | 2d179f5b | xthirioux | (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine) |
259 | 04a63d25 | xthirioux | machine_code); |
260 | 2d179f5b | xthirioux | |
261 | 6efbcb73 | xthirioux | (* Optimize machine code *) |
262 | let machine_code = |
||
263 | c287ba28 | xthirioux | if !Options.optimization >= 4 && !Options.output <> "horn" then |
264 | begin |
||
265 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: common sub-expression elimination@,"); |
266 | c287ba28 | xthirioux | Optimize_machine.machines_cse machine_code |
267 | end |
||
268 | else |
||
269 | machine_code |
||
270 | in |
||
271 | (* Optimize machine code *) |
||
272 | 04a63d25 | xthirioux | let machine_code, removed_table = |
273 | 6efbcb73 | xthirioux | if !Options.optimization >= 2 && !Options.output <> "horn" then |
274 | begin |
||
275 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: constants inlining@,"); |
276 | 6efbcb73 | xthirioux | Optimize_machine.machines_unfold (Corelang.get_consts prog) node_schs machine_code |
277 | end |
||
278 | else |
||
279 | 04a63d25 | xthirioux | machine_code, IMap.empty |
280 | in |
||
281 | 6efbcb73 | xthirioux | (* Optimize machine code *) |
282 | 04a63d25 | xthirioux | let machine_code = |
283 | 6efbcb73 | xthirioux | if !Options.optimization >= 3 && !Options.output <> "horn" then |
284 | begin |
||
285 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: minimize stack usage by reusing variables@,"); |
286 | 04a63d25 | xthirioux | let node_schs = Scheduling.remove_prog_inlined_locals removed_table node_schs in |
287 | let reuse_tables = Scheduling.compute_prog_reuse_table node_schs in |
||
288 | Optimize_machine.machines_fusion (Optimize_machine.machines_reuse_variables machine_code reuse_tables) |
||
289 | 6efbcb73 | xthirioux | end |
290 | else |
||
291 | machine_code |
||
292 | ec433d69 | xthirioux | in |
293 | 04a63d25 | xthirioux | |
294 | (* Salsa optimize machine code *) |
||
295 | (* |
||
296 | let machine_code = |
||
297 | if !Options.salsa_enabled then |
||
298 | begin |
||
299 | check_main (); |
||
300 | 45f0f48d | xthirioux | Log.report ~level:1 (fun fmt -> fprintf fmt ".. salsa machines optimization: optimizing floating-point accuracy with Salsa@,"); |
301 | 04a63d25 | xthirioux | (* Selecting float constants for Salsa *) |
302 | let constEnv = List.fold_left ( |
||
303 | fun accu c_topdecl -> |
||
304 | match c_topdecl.top_decl_desc with |
||
305 | | Const c when Types.is_real_type c.const_type -> |
||
306 | (c.const_id, c.const_value) :: accu |
||
307 | | _ -> accu |
||
308 | ) [] (Corelang.get_consts prog) |
||
309 | in |
||
310 | List.map |
||
311 | (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) |
||
312 | machine_code |
||
313 | end |
||
314 | else |
||
315 | machine_code |
||
316 | in |
||
317 | Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@ " |
||
318 | (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine) |
||
319 | machine_code); |
||
320 | *) |
||
321 | machine_code |
||
322 | c287ba28 | xthirioux | |
323 | 8deaa2dd | tkahsai | |
324 | 04a63d25 | xthirioux | (* printing code *) |
325 | let stage3 prog machine_code dependencies basename = |
||
326 | 6efbcb73 | xthirioux | let basename = Filename.basename basename in |
327 | 04a63d25 | xthirioux | match !Options.output with |
328 | dc893173 | ploc | "C" -> |
329 | 6efbcb73 | xthirioux | begin |
330 | dc893173 | ploc | Log.report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,"); |
331 | C_backend.translate_to_c |
||
332 | (* alloc_header_file source_lib_file source_main_file makefile_file *) |
||
333 | basename prog machine_code dependencies |
||
334 | 6efbcb73 | xthirioux | end |
335 | dc893173 | ploc | | "java" -> |
336 | begin |
||
337 | (Format.eprintf "internal error: sorry, but not yet supported !"; assert false) |
||
338 | (*let source_file = basename ^ ".java" in |
||
339 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. opening file %s@,@?" source_file); |
||
340 | let source_out = open_out source_file in |
||
341 | let source_fmt = formatter_of_out_channel source_out in |
||
342 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?"); |
||
343 | Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*) |
||
344 | end |
||
345 | | "horn" -> |
||
346 | begin |
||
347 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
348 | let source_file = destname ^ ".smt2" in (* Could be changed *) |
||
349 | let source_out = open_out source_file in |
||
350 | let fmt = formatter_of_out_channel source_out in |
||
351 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. hornification@,"); |
||
352 | Horn_backend.translate fmt basename prog (Machine_code.arrow_machine::machine_code); |
||
353 | (* Tracability file if option is activated *) |
||
354 | if !Options.traces then ( |
||
355 | let traces_file = destname ^ ".traces.xml" in (* Could be changed *) |
||
356 | let traces_out = open_out traces_file in |
||
357 | let fmt = formatter_of_out_channel traces_out in |
||
358 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. tracing info@,"); |
||
359 | Horn_backend_traces.traces_file fmt basename prog machine_code; |
||
360 | ) |
||
361 | end |
||
362 | | "lustre" -> |
||
363 | begin |
||
364 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
365 | let source_file = destname ^ ".lustrec.lus" in (* Could be changed *) |
||
366 | let source_out = open_out source_file in |
||
367 | let fmt = formatter_of_out_channel source_out in |
||
368 | Printers.pp_prog fmt prog; |
||
369 | (* Lustre_backend.translate fmt basename normalized_prog machine_code *) |
||
370 | () |
||
371 | end |
||
372 | a6df3992 | Ploc | | "emf" -> |
373 | begin |
||
374 | let destname = !Options.dest_dir ^ "/" ^ basename in |
||
375 | let source_file = destname ^ ".emf" in (* Could be changed *) |
||
376 | let source_out = open_out source_file in |
||
377 | let fmt = formatter_of_out_channel source_out in |
||
378 | EMF_backend.translate fmt prog; |
||
379 | () |
||
380 | end |
||
381 | dc893173 | ploc | |
382 | | _ -> assert false |
||
383 | 04a63d25 | xthirioux | |
384 | (* compile a .lus source file *) |
||
385 | let rec compile_source dirname basename extension = |
||
386 | let source_name = dirname ^ "/" ^ basename ^ extension in |
||
387 | |||
388 | Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>"); |
||
389 | |||
390 | (* Parsing source *) |
||
391 | let prog = parse_source source_name in |
||
392 | |||
393 | let prog = |
||
394 | if !Options.mpfr then |
||
395 | Mpfr.mpfr_module::prog |
||
396 | else |
||
397 | prog |
||
398 | in |
||
399 | let prog, dependencies = |
||
400 | try |
||
401 | stage1 prog dirname basename |
||
402 | with StopPhase1 prog -> ( |
||
403 | if !Options.lusi then |
||
404 | begin |
||
405 | let lusi_ext = extension ^ "i" in |
||
406 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating interface file %s@," (basename ^ lusi_ext)); |
||
407 | print_lusi prog dirname basename lusi_ext; |
||
408 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@."); |
||
409 | exit 0 |
||
410 | end |
||
411 | else |
||
412 | assert false |
||
413 | ) |
||
414 | 6efbcb73 | xthirioux | in |
415 | 04a63d25 | xthirioux | |
416 | let machine_code = |
||
417 | stage2 prog |
||
418 | in |
||
419 | if Scopes.Plugin.show_scopes () then |
||
420 | begin |
||
421 | let all_scopes = Scopes.compute_scopes prog !Options.main_node in |
||
422 | (* Printing scopes *) |
||
423 | if !Options.verbose_level >= 1 then |
||
424 | Format.printf "Possible scopes are:@ "; |
||
425 | Format.printf "@[<v>%a@ @]@.@?" Scopes.print_scopes all_scopes; |
||
426 | exit 0 |
||
427 | |||
428 | end; |
||
429 | |||
430 | let machine_code = |
||
431 | if Scopes.Plugin.is_active () then |
||
432 | Scopes.Plugin.process_scopes !Options.main_node prog machine_code |
||
433 | else |
||
434 | machine_code |
||
435 | in |
||
436 | |||
437 | stage3 prog machine_code dependencies basename; |
||
438 | Log.report ~level:1 (fun fmt -> fprintf fmt ".. done @ @]@."); |
||
439 | (* We stop the process here *) |
||
440 | exit 0 |
||
441 | 6efbcb73 | xthirioux | |
442 | let compile dirname basename extension = |
||
443 | match extension with |
||
444 | | ".lusi" -> compile_header dirname basename extension |
||
445 | | ".lus" -> compile_source dirname basename extension |
||
446 | | _ -> assert false |
||
447 | |||
448 | let anonymous filename = |
||
449 | let ok_ext, ext = List.fold_left |
||
450 | (fun (ok, ext) ext' -> |
||
451 | if not ok && Filename.check_suffix filename ext' then |
||
452 | true, ext' |
||
453 | else |
||
454 | ok, ext) |
||
455 | (false, "") extensions in |
||
456 | if ok_ext then |
||
457 | let dirname = Filename.dirname filename in |
||
458 | let basename = Filename.chop_suffix (Filename.basename filename) ext in |
||
459 | compile dirname basename ext |
||
460 | else |
||
461 | raise (Arg.Bad ("Can only compile *.lusi, *.lus or *.ec files")) |
||
462 | |||
463 | let _ = |
||
464 | 04a63d25 | xthirioux | Global.initialize (); |
465 | 6efbcb73 | xthirioux | Corelang.add_internal_funs (); |
466 | try |
||
467 | Printexc.record_backtrace true; |
||
468 | 04a63d25 | xthirioux | |
469 | let options = Options.options @ |
||
470 | List.flatten ( |
||
471 | List.map Options.plugin_opt [ |
||
472 | Scopes.Plugin.name, Scopes.Plugin.activate, Scopes.Plugin.options |
||
473 | ] |
||
474 | ) |
||
475 | in |
||
476 | |||
477 | Arg.parse options anonymous usage |
||
478 | 6efbcb73 | xthirioux | with |
479 | 04a63d25 | xthirioux | | Parse.Error _ |
480 | 6efbcb73 | xthirioux | | Types.Error (_,_) | Clocks.Error (_,_) |
481 | | Corelang.Error _ (*| Task_set.Error _*) |
||
482 | eb837d74 | xthirioux | | Causality.Error _ -> exit 1 |
483 | 6efbcb73 | xthirioux | | Sys_error msg -> (eprintf "Failure: %s@." msg) |
484 | | exc -> (Utils.track_exception (); raise exc) |
||
485 | |||
486 | (* Local Variables: *) |
||
487 | (* compile-command:"make -C .." *) |
||
488 | (* End: *) |