Added skeletons for compilers heptc and mlsc

This commit is contained in:
Cédric Pasteur 2010-06-18 14:00:58 +02:00
parent fb547ea508
commit ce4e0620a2
6 changed files with 240 additions and 259 deletions

View file

@ -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

View file

@ -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

56
minils/main/mls2seq.ml Normal file
View file

@ -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

View file

@ -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

100
minils/main/mlsc.ml Normal file
View file

@ -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 ()

View file

@ -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:"