4 (** Parse the command line. *)
6 if not (Options.is_web_mode ()) then
7 OptionsParsing.results ()
11 (** For each input file of the source language:
15 2. Add runtime functions.
19 4. Compile to the target language.
20 (And keep track of annotations if required).
22 5. Annotate the input program with collected costs.
24 6. Save the annotated input program.
26 Optionnally, we can interpret the intermediate programs
27 if {!Options.interpretation_requested}.
29 let process ?(step=fun step over -> ()) source =
30 (** Set source and target languages. *)
31 let src_language = Options.get_source_language () in
32 let tgt_language = Options.get_target_language () in
37 fun () -> incr c; step !c nb_step
40 (** These variables are related to the lustre mode of the compiler. *)
41 let is_lustre_file = Options.is_lustre_file () in
42 let remove_lustre_externals = Options.is_remove_lustre_externals () in
47 (Languages.parse ~is_lustre_file ~remove_lustre_externals src_language)
53 (** Embed the runtime functions in the abstract syntax tree. *)
54 let input_ast = Languages.add_runtime input_ast in
56 (** Labelling pass. *)
59 Languages.labelize input_ast
66 (** If debugging is enabled, the compilation function returns all
67 the intermediate programs. *)
70 (Options.is_debug_enabled ())
71 src_language tgt_language)
77 let final_ast, intermediate_asts = Misc.ListExt.cut_last target_asts in
79 (** Instrument the source file with cost annotations. *)
80 let (annotated_input_ast, cost_id, cost_incr, extern_cost_variables) =
82 (Languages.annotate input_ast)
86 (** Instrument the source file with cost annotations. *)
87 let (annotated_input_ast, stack_id, stack_max_id,
88 stack_incr, extern_stack_variables) =
89 profile "Annotation Stack"
90 Languages.annotate_stack_size cost_incr annotated_input_ast
95 (** Combine the output asts. *)
96 let output = (target_asts, annotated_input_ast) in
98 (** Finally save these output if we are not in a web mode. *)
100 if not (Options.is_web_mode ()) then
101 let filename = match source with `Filename f -> f | _ -> assert false in
102 let (exact_output, output_filename) = match Options.get_output_files () with
103 | None -> (false, filename)
104 | Some filename' -> (true, filename') in
105 let save ?(suffix="") ast =
107 (Options.is_asm_pretty ()) exact_output output_filename suffix ast
111 save ~suffix:"-instrumented" annotated_input_ast;
112 Languages.save_cost exact_output output_filename cost_id cost_incr
113 extern_cost_variables;
115 exact_output output_filename
116 stack_id stack_max_id stack_incr extern_stack_variables;
117 if Options.is_debug_enabled () then
118 List.iter save intermediate_asts;
121 (** Interpret all the intermediate ASTs if requested. *)
122 if Options.interpretations_requested () then
124 Printf.printf "Interpret\n%!" ;
125 let asts = target_asts in
126 let debug = Options.is_debug_enabled () in
127 let label_traces = List.map (Languages.interpret debug) asts in
128 Misc.IOExt.eprintf "Checking execution traces...%!";
129 Checker.same_traces (List.combine asts label_traces);
130 Misc.IOExt.eprintf "OK.\n%!";
133 (** Interpret the final AST if requested. *)
134 if Options.interpretation_requested () then
135 ignore (Languages.interpret (Options.is_debug_enabled ()) final_ast)
137 (** Return the output ASTs. *)
140 let lustre_test (filename : string) =
141 let lustre_test = match Options.get_lustre_test () with
142 | None -> assert false (* do not use on this argument *)
143 | Some lustre_test -> lustre_test in
144 let lustre_test_cases = Options.get_lustre_test_cases () in
145 let lustre_test_cycles = Options.get_lustre_test_cycles () in
146 let lustre_test_min_int = Options.get_lustre_test_min_int () in
147 let lustre_test_max_int = Options.get_lustre_test_max_int () in
148 let src_language = Languages.Clight in
149 let tgt_language = Languages.Clight in
150 let input_ast = Languages.parse src_language (`Filename filename) in
152 Languages.add_lustre_main lustre_test lustre_test_cases lustre_test_cycles
153 lustre_test_min_int lustre_test_max_int input_ast in
154 let (exact_output, output_filename) = match Options.get_output_files () with
155 | None -> (false, filename)
156 | Some filename' -> (true, filename')
160 (Options.is_asm_pretty ()) exact_output output_filename "" ast in
162 Languages.compile false src_language tgt_language input_ast
164 let final_ast, _ = Misc.ListExt.cut_last target_asts in
169 Misc.Timed.set_profiling_flag (Options.is_debug_enabled () || Options.is_web_mode ());
170 if not (Options.is_web_mode ()) then
172 set_now (fun () -> 0.); (* Unix.gettimeofday () *. 1000.); *)
173 if Options.is_dev_test_enabled () then
174 Dev_test.do_dev_test input_files
176 if Options.get_lustre_test () <> None then
177 List.iter lustre_test input_files
179 ignore (List.map process (List.map (fun f -> `Filename f) input_files))