Added skeletons for compilers heptc and mlsc
This commit is contained in:
Cédric Pasteur
parent
fb547ea508
commit
ce4e0620a2
|
|
@ -13,11 +13,6 @@ open Misc
|
|||
open Compiler_utils
|
||||
open Location
|
||||
|
||||
let init_compiler modname source_name ic =
|
||||
Location.initialize source_name ic;
|
||||
Modules.initialize modname;
|
||||
Initial.initialize ()
|
||||
|
||||
let pp = Printer.print stdout
|
||||
|
||||
let parse_implementation lexbuf =
|
||||
|
|
@ -105,18 +100,6 @@ let compile file =
|
|||
else
|
||||
raise (Arg.Bad ("Unknow file type: " ^ file))
|
||||
|
||||
let doc_verbose = "\t\t\tSet verbose mode"
|
||||
and doc_version = "\t\tThe version of the compiler"
|
||||
and doc_print_types = "\t\t\tPrint types"
|
||||
and doc_include = "<dir>\t\tAdd <dir> to the list of include directories"
|
||||
and doc_stdlib = "<dir>\t\tDirectory for the standard library"
|
||||
and doc_locate_stdlib = "\t\tLocate standard libray"
|
||||
and doc_no_pervasives = "\tDo not load the pervasives module"
|
||||
and doc_full_type_info = "\t\t\tPrint full type information"
|
||||
and doc_noinit = "\t\tDisable initialization analysis"
|
||||
|
||||
let errmsg = "Options are:"
|
||||
|
||||
let main () =
|
||||
try
|
||||
Arg.parse
|
||||
|
|
|
|||
254
main/compiler.ml
254
main/compiler.ml
|
|
@ -10,98 +10,7 @@
|
|||
|
||||
open Location
|
||||
open Misc
|
||||
open Global
|
||||
|
||||
let lexical_error err loc =
|
||||
Printf.eprintf "%aIllegal character.\n" output_location loc;
|
||||
raise Error
|
||||
|
||||
let syntax_error loc =
|
||||
Printf.eprintf "%aSyntax error.\n" output_location loc;
|
||||
raise Error
|
||||
|
||||
let language_error lang =
|
||||
Printf.eprintf "Unknown language: %s.\n" lang
|
||||
|
||||
let parse parsing_fun lexing_fun lexbuf =
|
||||
try
|
||||
parsing_fun lexing_fun lexbuf
|
||||
with
|
||||
| Lexer.Lexical_error(err, pos1, pos2) ->
|
||||
lexical_error err (Loc(pos1, pos2))
|
||||
| Parsing.Parse_error ->
|
||||
let pos1 = Lexing.lexeme_start lexbuf
|
||||
and pos2 = Lexing.lexeme_end lexbuf in
|
||||
let l = Loc(pos1,pos2) in
|
||||
syntax_error l
|
||||
|
||||
let comment s = Printf.printf "** %s done **\n" s; flush stdout
|
||||
|
||||
let build_path suf =
|
||||
match !target_path with
|
||||
| None -> suf
|
||||
| Some path -> Filename.concat path suf
|
||||
|
||||
let clean_dir dir =
|
||||
if Sys.file_exists dir && Sys.is_directory dir
|
||||
then begin
|
||||
let rm_file_in_dir fn = Sys.remove (Filename.concat dir fn) in
|
||||
Array.iter rm_file_in_dir (Sys.readdir dir);
|
||||
end else Unix.mkdir dir 0o740;
|
||||
dir
|
||||
|
||||
(** Generation of a dataflow target *)
|
||||
let dataflow_target filename p target_languages =
|
||||
let rec one_target = function
|
||||
(* | "z3z" :: others ->
|
||||
let dirname = build_path (filename ^ "_z3z") in
|
||||
let dir = clean_dir dirname in
|
||||
let p = Dynamic_system.program p in
|
||||
if !verbose then
|
||||
comment "Translation into dynamic system (Z/3Z equations)";
|
||||
Sigali.Printer.print dir p;
|
||||
one_target others *)
|
||||
| ("vhdl_df" | "vhdl") :: others ->
|
||||
let dirname = build_path (filename ^ "_vhdl") in
|
||||
let dir = clean_dir dirname in
|
||||
let vhdl = Mls2vhdl.translate (Filename.basename filename) p in
|
||||
Vhdl.print dir vhdl;
|
||||
one_target others
|
||||
| unknown_lg :: others -> unknown_lg :: one_target others
|
||||
| [] -> [] in
|
||||
one_target target_languages
|
||||
|
||||
(** Generation of a sequential target *)
|
||||
let sequential_target filename o target_languages =
|
||||
let rec one_target = function
|
||||
| "c-old" :: others ->
|
||||
let dirname = build_path (filename ^ "_c-old") in
|
||||
let dir = clean_dir dirname in
|
||||
C_old.print o dir;
|
||||
one_target others
|
||||
| "java" :: others ->
|
||||
let dirname = build_path filename in
|
||||
let dir = clean_dir dirname in
|
||||
Java.print dir o;
|
||||
one_target others
|
||||
| "c" :: others ->
|
||||
let dirname = build_path (filename ^ "_c") in
|
||||
let dir = clean_dir dirname in
|
||||
let c_ast = Cgen.translate filename o in
|
||||
C.output dir c_ast;
|
||||
one_target others
|
||||
| "caml" :: others -> Caml.print filename o; one_target others
|
||||
| unknown_lg :: others -> unknown_lg :: one_target others
|
||||
| [] -> [] in
|
||||
one_target target_languages
|
||||
|
||||
(** Whole translation. *)
|
||||
let targets filename df obc target_languages =
|
||||
let target_languages = dataflow_target filename df target_languages in
|
||||
let target_languages = sequential_target filename obc target_languages in
|
||||
match target_languages with
|
||||
| [] -> ()
|
||||
| target :: _ -> language_error target
|
||||
open Compiler_utils
|
||||
|
||||
let parse_implementation lexbuf =
|
||||
parse Parser.program Lexer.token lexbuf
|
||||
|
|
@ -139,39 +48,17 @@ let interface modname filename =
|
|||
with
|
||||
| x -> close_all_files (); raise x
|
||||
|
||||
let do_pass f d p pp enabled =
|
||||
if enabled
|
||||
then
|
||||
let r = f p in
|
||||
if !verbose
|
||||
then begin
|
||||
comment d;
|
||||
pp r;
|
||||
end;
|
||||
r
|
||||
else p
|
||||
|
||||
let do_silent_pass f d p enabled =
|
||||
if enabled
|
||||
then begin
|
||||
let r = f p in
|
||||
if !verbose then comment d; r
|
||||
end
|
||||
else p
|
||||
|
||||
let compile modname filename =
|
||||
(* input and output files *)
|
||||
let source_name = filename ^ ".ept"
|
||||
and obj_interf_name = filename ^ ".epci"
|
||||
and mls_name = filename ^ ".mls"
|
||||
and mls_norm_name = filename ^ "_norm.mls"
|
||||
and obc_name = filename ^ ".obc"
|
||||
and ml_name = filename ^ ".ml" in
|
||||
|
||||
let ic = open_in source_name
|
||||
and itc = open_out_bin obj_interf_name
|
||||
and mlsc = open_out mls_name
|
||||
and mlsnc = open_out mls_norm_name
|
||||
and obc = open_out obc_name
|
||||
and mlc = open_out ml_name in
|
||||
|
||||
|
|
@ -183,9 +70,7 @@ let compile modname filename =
|
|||
close_out mlc in
|
||||
|
||||
try
|
||||
Location.initialize source_name ic;
|
||||
Modules.initialize modname;
|
||||
Initial.initialize ();
|
||||
init_compiler modname source_name ic;
|
||||
|
||||
let pp = Printer.print stdout in
|
||||
|
||||
|
|
@ -201,137 +86,22 @@ let compile modname filename =
|
|||
pp p
|
||||
end;
|
||||
|
||||
(* Misc.reset_symbol (); *)
|
||||
(* Process the Heptagon AST *)
|
||||
Hept_compiler.compile pp p;
|
||||
|
||||
(* Typing *)
|
||||
let p = do_pass Typing.program "Typing" p pp true in
|
||||
(* Compile Heptagon to MinilLs *)
|
||||
let p = Hep2mls.program p;
|
||||
|
||||
(* Linear typing *)
|
||||
let p = do_pass Linear_typing.program "Linear Typing" p pp (not !no_mem_alloc) in
|
||||
|
||||
if !print_types then Interface.Printer.print stdout;
|
||||
Modules.write itc;
|
||||
|
||||
(* Causality check *)
|
||||
let p =
|
||||
do_silent_pass Causality.program "Causality check" p true in
|
||||
|
||||
(* Initialization check *)
|
||||
let p =
|
||||
do_silent_pass Initialization.program "Initialization check" p !init in
|
||||
|
||||
(* Mark nodes to be inlined *)
|
||||
(* let to_inline = List.map Misc.mk_longname !nodes_to_inline in
|
||||
let p = Inline.mark_calls_to to_inline p in
|
||||
let p = match !node_to_flatten with
|
||||
| None -> p
|
||||
| Some nn -> Inline.flatten nn p in
|
||||
if !verbose then comment "Inlining pre-pass";*)
|
||||
|
||||
(* Inline marked nodes *)
|
||||
(* let p = do_pass Inline.program "Inlining" p pp true in *)
|
||||
|
||||
(* Automata memory sharing *)
|
||||
let p = do_pass Automata_mem.program "Automata memory sharing" p pp (not !no_mem_alloc) in
|
||||
|
||||
(* Completion of partial definitions *)
|
||||
let p = do_pass Completion.program "Completion" p pp true in
|
||||
|
||||
(* Automata *)
|
||||
let p = do_pass Automata.program "Automata" p pp true in
|
||||
|
||||
(* Present *)
|
||||
let p = do_pass Present.program "Present" p pp true in
|
||||
|
||||
(* Shared variables (last) *)
|
||||
let p = do_pass Last.program "Last" p pp true in
|
||||
|
||||
(* Reset *)
|
||||
let reset_prog = if !use_new_reset_encoding then Reset_new.program else Reset.program in
|
||||
let p = do_pass reset_prog "Reset" p pp true in
|
||||
|
||||
(* Every *)
|
||||
let p = do_pass Every.program "Every" p pp true in
|
||||
|
||||
(* Merge and translate the heptagon program into the *)
|
||||
(* clocked data-flow language mini-ls *)
|
||||
let pp = Minils.Printer.print stdout in
|
||||
|
||||
let p = Merge.program p in
|
||||
if !verbose then comment "Translation into clocked equations";
|
||||
if !verbose then comment "Translation into MiniLs";
|
||||
Minils.Printer.print mlsc p;
|
||||
|
||||
(* Annotation of expressions with their clock *)
|
||||
let p = Clocking.program p in
|
||||
(* Process the MiniLs AST *)
|
||||
Mls_compiler.compile pp p;
|
||||
|
||||
(* Mls2dot.program "" p; *)
|
||||
|
||||
(** Start of data-flow optimizations *)
|
||||
(* Normalization to maximize opportunities *)
|
||||
let p = do_pass Normalize.program "Normalization" p pp true in
|
||||
|
||||
(* Back-end causality check. Only useful to check that *)
|
||||
(* we did not make any mistake during code generation *)
|
||||
let p =
|
||||
do_silent_pass Dfcausality.program "Post-pass causality check" p true in
|
||||
|
||||
(* Check that the dataflow code is well initialized *)
|
||||
(*
|
||||
let p =
|
||||
do_silent_pass Init.program "Post-pass initialization check" p true in
|
||||
*)
|
||||
|
||||
let sigali = List.mem "z3z" !target_languages in
|
||||
|
||||
(* Boolean translation of enumerated values *)
|
||||
(* let p =
|
||||
do_pass
|
||||
Boolean.program "Boolean transformation" p pp (!boolean or sigali) in
|
||||
*)
|
||||
|
||||
(* Normalization to maximize opportunities *)
|
||||
let p = do_pass Normalize.program "Normalization" p pp true in
|
||||
|
||||
(* Mls2dot.program "normalized_" p; *)
|
||||
|
||||
let p =
|
||||
do_pass Deadcode.program "Deadcode removal" p pp !deadcode in
|
||||
|
||||
(* Automata minimization *)
|
||||
let p = do_pass Tommls.program "Automata minimization" p pp !tomato in
|
||||
|
||||
(* Common sub-expression elimination *)
|
||||
let p =
|
||||
do_pass Cmse.program "Common sub-expression elimination" p pp !cse in
|
||||
|
||||
(* Removing intermediate equations *)
|
||||
let p =
|
||||
do_pass Intermediate.program "Intermediate-equations removal"
|
||||
p pp !intermediate in
|
||||
|
||||
Mls2dot.program "optimized_" p;
|
||||
|
||||
(* Splitting *)
|
||||
let p = do_pass Splitting.program "Splitting" p pp (not !no_mem_alloc) in
|
||||
|
||||
(* Scheduling *)
|
||||
let scheduler = if !use_interf_scheduler then Schedule_interf.program else Schedule.program in
|
||||
let p = do_pass scheduler "Scheduling" p pp true in
|
||||
|
||||
(* Memory allocation *)
|
||||
Interference.world.Interference.node_is_scheduled <- true;
|
||||
let p = do_pass Memalloc.program
|
||||
"Interference graph building and Memory Allocation" p pp (not !no_mem_alloc) in
|
||||
|
||||
(* Parametrized functions instantiation *)
|
||||
let p = do_pass Callgraph.program
|
||||
"Parametrized functions instantiation" p pp true in
|
||||
|
||||
Minils.Printer.print mlsnc p;
|
||||
|
||||
(* Producing Object-based code *)
|
||||
let o = Translate.program p in
|
||||
if !verbose then comment "Translation into Object-based code";
|
||||
(* Compile MiniLs to Obc *)
|
||||
let o = Mls2obc.program p in
|
||||
if !verbose then comment "Translation into Obc";
|
||||
Obc.Printer.print obc o;
|
||||
|
||||
let pp = Obc.Printer.print stdout in
|
||||
|
|
|
|||
|
|
@ -0,0 +1,56 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* Heptagon *)
|
||||
(* *)
|
||||
(* Author : Marc Pouzet *)
|
||||
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(** Generation of a dataflow target *)
|
||||
let dataflow_target filename p target_languages =
|
||||
let rec one_target = function
|
||||
(* | "z3z" :: others ->
|
||||
let dirname = build_path (filename ^ "_z3z") in
|
||||
let dir = clean_dir dirname in
|
||||
let p = Dynamic_system.program p in
|
||||
if !verbose then
|
||||
comment "Translation into dynamic system (Z/3Z equations)";
|
||||
Sigali.Printer.print dir p;
|
||||
one_target others
|
||||
| ("vhdl_df" | "vhdl") :: others ->
|
||||
let dirname = build_path (filename ^ "_vhdl") in
|
||||
let dir = clean_dir dirname in
|
||||
let vhdl = Mls2vhdl.translate (Filename.basename filename) p in
|
||||
Vhdl.print dir vhdl;
|
||||
one_target others *)
|
||||
| unknown_lg :: others -> unknown_lg :: one_target others
|
||||
| [] -> [] in
|
||||
one_target target_languages
|
||||
|
||||
(** Generation of a sequential target *)
|
||||
let sequential_target filename o target_languages =
|
||||
let rec one_target = function
|
||||
| "java" :: others ->
|
||||
let dirname = build_path filename in
|
||||
let dir = clean_dir dirname in
|
||||
Java.print dir o;
|
||||
one_target others
|
||||
| "c" :: others ->
|
||||
let dirname = build_path (filename ^ "_c") in
|
||||
let dir = clean_dir dirname in
|
||||
let c_ast = Cgen.translate filename o in
|
||||
C.output dir c_ast;
|
||||
one_target others
|
||||
| unknown_lg :: others -> unknown_lg :: one_target others
|
||||
| [] -> [] in
|
||||
one_target target_languages
|
||||
|
||||
(** Whole translation. *)
|
||||
let targets filename df obc target_languages =
|
||||
let target_languages = dataflow_target filename df target_languages in
|
||||
let target_languages = sequential_target filename obc target_languages in
|
||||
match target_languages with
|
||||
| [] -> ()
|
||||
| target :: _ -> language_error target
|
||||
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* Heptagon *)
|
||||
(* *)
|
||||
(* Author : Marc Pouzet *)
|
||||
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
open Misc
|
||||
open Compiler_utils
|
||||
|
||||
let compile pp p =
|
||||
(* Clocking *)
|
||||
let p = do_silent_pass Clocking.program "Clocking" p true in
|
||||
|
||||
(* Back-end causality check. Only useful to check that *)
|
||||
(* we did not make any mistake during code generation *)
|
||||
let p =
|
||||
do_silent_pass Dfcausality.program "Causality check" p true in
|
||||
|
||||
(* Check that the dataflow code is well initialized *)
|
||||
let p =
|
||||
do_silent_pass Init.program "Initialization check" p !init in
|
||||
|
||||
(* Normalization to maximize opportunities *)
|
||||
let p = do_pass Normalize.program "Normalization" p pp true in
|
||||
|
||||
(* Scheduling *)
|
||||
let p = do_pass Schedule.program "Scheduling" p pp true in
|
||||
|
||||
(* Parametrized functions instantiation *)
|
||||
let p = do_pass Callgraph.program
|
||||
"Parametrized functions instantiation" p pp true in
|
||||
|
||||
p
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* Heptagon *)
|
||||
(* *)
|
||||
(* Author : Marc Pouzet *)
|
||||
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
let generate_targets p =
|
||||
(* Producing Object-based code *)
|
||||
let o = Translate.program p in
|
||||
if !verbose then comment "Translation into Object-based code";
|
||||
Obc.Printer.print obc o;
|
||||
|
||||
let pp = Obc.Printer.print stdout in
|
||||
if !verbose then pp o;
|
||||
|
||||
(* Translation into dataflow and sequential languages *)
|
||||
targets filename p o !target_languages
|
||||
|
||||
let parse_implementation lexbuf =
|
||||
parse Parser.program Lexer.token lexbuf
|
||||
|
||||
let compile_impl modname filename =
|
||||
(* input and output files *)
|
||||
(* input and output files *)
|
||||
let mls_name = filename ^ ".mls"
|
||||
and mls_norm_name = filename ^ "_norm.mls"
|
||||
and obc_name = filename ^ ".obc" in
|
||||
|
||||
let mlsc = open_out mls_name
|
||||
and mlsnc = open_out mls_norm_name
|
||||
and obc = open_out obc_name in
|
||||
|
||||
let close_all_files () =
|
||||
close_out mlsc;
|
||||
close_out obc;
|
||||
close_out mlsnc
|
||||
in
|
||||
|
||||
try
|
||||
init_compiler modname source_name ic;
|
||||
|
||||
(* Parsing of the file *)
|
||||
let lexbuf = Lexing.from_channel ic in
|
||||
let p = parse_implementation lexbuf in
|
||||
|
||||
(* Convert the parse tree to Heptagon AST *)
|
||||
let p = Scoping.translate_program p in
|
||||
if !verbose
|
||||
then begin
|
||||
comment "Parsing";
|
||||
pp p
|
||||
end;
|
||||
|
||||
(* Call the compiler*)
|
||||
Hept_compiler.compile_impl pp p;
|
||||
|
||||
if !verbose
|
||||
then begin
|
||||
comment "Checking"
|
||||
end;
|
||||
close_all_files ()
|
||||
|
||||
with x -> close_all_files (); raise x
|
||||
|
||||
let compile file =
|
||||
if Filename.check_suffix file ".mls" then
|
||||
let filename = Filename.chop_suffix file ".ept" in
|
||||
let modname = String.capitalize(Filename.basename filename) in
|
||||
compile_impl modname filename
|
||||
else
|
||||
raise (Arg.Bad ("Unknow file type: " ^ file))
|
||||
|
||||
let errmsg = "Options are:"
|
||||
|
||||
let main () =
|
||||
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;
|
||||
"-s", Arg.String set_simulation_node, doc_sim;
|
||||
"-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;
|
||||
"-noinit", Arg.Clear init, doc_noinit;
|
||||
"-fti", Arg.Set full_type_info, doc_full_type_info;
|
||||
]
|
||||
compile
|
||||
errmsg;
|
||||
with
|
||||
| Misc.Error -> exit 2;;
|
||||
|
||||
main ()
|
||||
|
|
@ -53,3 +53,40 @@ let do_silent_pass f d p enabled =
|
|||
if !verbose then comment d; r
|
||||
end
|
||||
else p
|
||||
|
||||
let build_path suf =
|
||||
match !target_path with
|
||||
| None -> suf
|
||||
| Some path -> Filename.concat path suf
|
||||
|
||||
let clean_dir dir =
|
||||
if Sys.file_exists dir && Sys.is_directory dir
|
||||
then begin
|
||||
let rm_file_in_dir fn = Sys.remove (Filename.concat dir fn) in
|
||||
Array.iter rm_file_in_dir (Sys.readdir dir);
|
||||
end else Unix.mkdir dir 0o740;
|
||||
dir
|
||||
|
||||
let init_compiler modname source_name ic =
|
||||
Location.initialize source_name ic;
|
||||
Modules.initialize modname;
|
||||
Initial.initialize ()
|
||||
|
||||
let doc_verbose = "\t\t\tSet verbose mode"
|
||||
and doc_version = "\t\tThe version of the compiler"
|
||||
and doc_print_types = "\t\t\tPrint types"
|
||||
and doc_include = "<dir>\t\tAdd <dir> to the list of include directories"
|
||||
and doc_stdlib = "<dir>\t\tDirectory for the standard library"
|
||||
and doc_sim = "<node>\t\tCreate simulation for node <node>"
|
||||
and doc_locate_stdlib = "\t\tLocate standard libray"
|
||||
and doc_no_pervasives = "\tDo not load the pervasives module"
|
||||
and doc_target =
|
||||
"<lang>\tGenerate code in language <lang>\n\t\t\t(with <lang>=c,"
|
||||
^ " vhdl_seq, vhdl_df,\n\t\t\t java or z3z)"
|
||||
and doc_full_type_info = "\t\t\tPrint full type information"
|
||||
and doc_target_path =
|
||||
"<path>\tGenerated files will be placed in <path>\n\t\t\t(the directory is cleaned)"
|
||||
and doc_noinit = "\t\tDisable initialization analysis"
|
||||
|
||||
let errmsg = "Options are:"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue