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