From ce4e0620a2275aa28df760263b814a9e53ac9fe3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Fri, 18 Jun 2010 14:00:58 +0200 Subject: [PATCH] Added skeletons for compilers heptc and mlsc --- heptagon/main/heptcheck.ml | 17 -- main/compiler.ml | 254 ++--------------------------- minils/main/mls2seq.ml | 56 +++++++ minils/main/mls_compiler.ml | 35 ++++ minils/main/mlsc.ml | 100 ++++++++++++ utilities/global/compiler_utils.ml | 37 +++++ 6 files changed, 240 insertions(+), 259 deletions(-) create mode 100644 minils/main/mls2seq.ml create mode 100644 minils/main/mls_compiler.ml create mode 100644 minils/main/mlsc.ml diff --git a/heptagon/main/heptcheck.ml b/heptagon/main/heptcheck.ml index b380316..cc5e4f3 100644 --- a/heptagon/main/heptcheck.ml +++ b/heptagon/main/heptcheck.ml @@ -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 = "\t\tAdd to the list of include directories" -and doc_stdlib = "\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 diff --git a/main/compiler.ml b/main/compiler.ml index 045faa5..47e4f77 100644 --- a/main/compiler.ml +++ b/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 diff --git a/minils/main/mls2seq.ml b/minils/main/mls2seq.ml new file mode 100644 index 0000000..cdb6829 --- /dev/null +++ b/minils/main/mls2seq.ml @@ -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 + diff --git a/minils/main/mls_compiler.ml b/minils/main/mls_compiler.ml new file mode 100644 index 0000000..9e8526e --- /dev/null +++ b/minils/main/mls_compiler.ml @@ -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 diff --git a/minils/main/mlsc.ml b/minils/main/mlsc.ml new file mode 100644 index 0000000..a82aa13 --- /dev/null +++ b/minils/main/mlsc.ml @@ -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 () diff --git a/utilities/global/compiler_utils.ml b/utilities/global/compiler_utils.ml index 8772336..cb803c8 100644 --- a/utilities/global/compiler_utils.ml +++ b/utilities/global/compiler_utils.ml @@ -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 = "\t\tAdd to the list of include directories" +and doc_stdlib = "\t\tDirectory for the standard library" +and doc_sim = "\t\tCreate simulation for node " +and doc_locate_stdlib = "\t\tLocate standard libray" +and doc_no_pervasives = "\tDo not load the pervasives module" +and doc_target = + "\tGenerate code in language \n\t\t\t(with =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 = + "\tGenerated files will be placed in \n\t\t\t(the directory is cleaned)" +and doc_noinit = "\t\tDisable initialization analysis" + +let errmsg = "Options are:" +