be21bf31d8
To enable recovery of parameter and output ordering by `ctrl2ept', the Controllable-Nbac generation procedure now declares a new module dedicated to the encapsulation of the controller functions yet to be synthesized. Handling of type declarations are probably buggy.
167 lines
7.2 KiB
OCaml
167 lines
7.2 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* Heptagon *)
|
|
(* *)
|
|
(* Gwenael Delaval, LIG/INRIA, UJF *)
|
|
(* Leonard Gerard, Parkas, ENS *)
|
|
(* Adrien Guatto, Parkas, ENS *)
|
|
(* Cedric Pasteur, Parkas, ENS *)
|
|
(* Marc Pouzet, Parkas, ENS *)
|
|
(* *)
|
|
(* Copyright 2012 ENS, INRIA, UJF *)
|
|
(* *)
|
|
(* This file is part of the Heptagon compiler. *)
|
|
(* *)
|
|
(* Heptagon is free software: you can redistribute it and/or modify it *)
|
|
(* under the terms of the GNU General Public License as published by *)
|
|
(* the Free Software Foundation, either version 3 of the License, or *)
|
|
(* (at your option) any later version. *)
|
|
(* *)
|
|
(* Heptagon is distributed in the hope that it will be useful, *)
|
|
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
|
|
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
|
|
(* GNU General Public License for more details. *)
|
|
(* *)
|
|
(* You should have received a copy of the GNU General Public License *)
|
|
(* along with Heptagon. If not, see <http://www.gnu.org/licenses/> *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
|
|
open Compiler_utils
|
|
open Compiler_options
|
|
|
|
|
|
let compile_interface modname source_f =
|
|
|
|
(* output file names *)
|
|
let output = String.uncapitalize modname in
|
|
let epci_f = output ^ ".epci" in
|
|
|
|
(* input/output channels *)
|
|
let source_c, lexbuf = lexbuf_from_file source_f in
|
|
let epci_c = open_out_bin epci_f in
|
|
let close_all_files () = close_in source_c; close_out epci_c in
|
|
|
|
try
|
|
(* Process the [lexbuf] to an Heptagon AST *)
|
|
let p = Hept_parser_scoper.parse_interface modname lexbuf in
|
|
if !print_types then Global_printer.print_interface Format.std_formatter;
|
|
|
|
(* Process the interface *)
|
|
let p = Hept_compiler.compile_interface p in
|
|
(* Output the .epci *)
|
|
output_value epci_c (Modules.current_module ());
|
|
(* Translate to Obc *)
|
|
let p = Hept2mls.interface p in
|
|
(* Generate the sequential code *)
|
|
Mls2seq.interface p;
|
|
close_all_files ()
|
|
with
|
|
| x -> close_all_files (); raise x
|
|
|
|
(* [modname] is the module name, [source_f] is the source file *)
|
|
let compile_program modname source_f =
|
|
|
|
(* output file names *)
|
|
let output = String.uncapitalize modname in
|
|
let epci_f = output ^ ".epci" in
|
|
let mls_f = output ^ ".mls" in
|
|
|
|
(* input/output channels *)
|
|
let source_c, lexbuf = lexbuf_from_file source_f in
|
|
let epci_c = open_out_bin epci_f in
|
|
let mls_c = open_out mls_f in
|
|
let close_all_files () = close_in source_c; close_out epci_c; close_out mls_c in
|
|
|
|
try
|
|
(* Activates passes according to the backend used *)
|
|
Mls2seq.load_conf ();
|
|
(* Record timing information *)
|
|
Compiler_timings.start_compiling modname;
|
|
(* Process the [lexbuf] to an Heptagon AST *)
|
|
let p = Hept_parser_scoper.parse_program modname lexbuf in
|
|
(* Process the Heptagon AST *)
|
|
let p = Hept_compiler.compile_program p in
|
|
(* Compile Heptagon to MiniLS *)
|
|
let p = do_pass "Translation into MiniLS" Hept2mls.program p Mls_compiler.pp in
|
|
(* Output the .mls *)
|
|
do_silent_pass "MiniLS serialization" (fun () -> Mls_printer.print mls_c p) ();
|
|
(* Process the MiniLS AST *)
|
|
let p = Mls_compiler.compile_program p in
|
|
(* Output the .epci *)
|
|
output_value epci_c (Modules.current_module ());
|
|
(* Generate the sequential code *)
|
|
Mls2seq.program p;
|
|
close_all_files ();
|
|
Compiler_timings.report_statistics ()
|
|
with x -> close_all_files (); raise x
|
|
|
|
|
|
|
|
let compile source_f =
|
|
let modname = source_f |> Filename.basename |> Filename.chop_extension |> String.capitalize in
|
|
let modul = Names.modul_of_string modname in
|
|
Initial.initialize modul;
|
|
source_f |> Filename.dirname |> add_include;
|
|
check_options ();
|
|
match Misc.file_extension source_f with
|
|
| "ept" -> compile_program modname source_f
|
|
| "epi" -> compile_interface modname source_f
|
|
| ext -> raise (Arg.Bad ("Unknow file type: " ^ ext ^ " for file: " ^ source_f))
|
|
|
|
|
|
|
|
(** [main] function to be launched *)
|
|
let main () =
|
|
let read_qualname f =
|
|
Arg.String (fun s -> f (try Names.qualname_of_string s with
|
|
| Exit -> raise (Arg.Bad ("Invalid name: "^ s)))) in
|
|
try
|
|
Arg.parse
|
|
[
|
|
"-v",Arg.Set verbose, doc_verbose;
|
|
"-version", Arg.Unit show_version, doc_version;
|
|
"-i", Arg.Set print_types, doc_print_types;
|
|
"-I", Arg.String add_include, doc_include;
|
|
"-where", Arg.Unit locate_stdlib, doc_locate_stdlib;
|
|
"-stdlib", Arg.String set_stdlib, doc_stdlib;
|
|
"-c", Arg.Set create_object_file, doc_object_file;
|
|
"-s", Arg.String set_simulation_node, doc_sim;
|
|
"-hepts", Arg.Set hepts_simulation, doc_hepts;
|
|
"-bool", Arg.Set boolean, doc_boolean;
|
|
"-deadcode", Arg.Set deadcode, doc_deadcode;
|
|
"-tomato", Arg.Set tomato, doc_tomato;
|
|
"-tomanode", read_qualname add_tomato_node, doc_tomato;
|
|
"-tomacheck", read_qualname add_tomato_check, "";
|
|
"-inline", read_qualname add_inlined_node, doc_inline;
|
|
"-flatten", Arg.Set flatten, doc_flatten;
|
|
"-assert", Arg.String add_assert, doc_assert;
|
|
"-nopervasives", Arg.Unit set_no_pervasives, doc_no_pervasives;
|
|
"-target", Arg.String add_target_language, doc_target;
|
|
"-targetpath", Arg.String set_target_path, doc_target_path;
|
|
"-nocaus", Arg.Clear causality, doc_nocaus;
|
|
"-noinit", Arg.Clear init, doc_noinit;
|
|
"-fti", Arg.Set full_type_info, doc_full_type_info;
|
|
"-statefuli", Arg.Set stateful_info, doc_stateful_info;
|
|
"-fname", Arg.Set full_name, doc_full_name;
|
|
"-nbvars", Arg.Set nbvars, doc_nbvars;
|
|
"-itfusion", Arg.Set do_iterator_fusion, doc_itfusion;
|
|
"-strict_ssa", Arg.Unit set_strict_ssa, doc_strict_ssa;
|
|
"-nosink", Arg.Set nosink, doc_nosink;
|
|
"-memalloc", Arg.Unit do_mem_alloc_and_typing, doc_memalloc;
|
|
"-only-memalloc", Arg.Set do_mem_alloc, doc_memalloc_only;
|
|
"-only-linear", Arg.Set do_linear_typing, doc_linear_only;
|
|
"-old-scheduler", Arg.Set use_old_scheduler, doc_interf_scheduler;
|
|
"-unroll", Arg.Set unroll_loops, doc_unroll;
|
|
"-O", Arg.Unit do_optim, doc_optim;
|
|
"-mall", Arg.Set interf_all, doc_interf_all;
|
|
"-time", Arg.Set time_passes, doc_time_passes;
|
|
]
|
|
compile errmsg;
|
|
with
|
|
| Errors.Error -> exit 2;;
|
|
|
|
|
|
(** Launch the [main] *)
|
|
main ()
|