From 2a6db8cb790acbab20660ad9cc825d852dfdd35a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Fri, 18 Jun 2010 15:40:48 +0200 Subject: [PATCH] Heptc works !! --- heptagon/main/heptcheck.ml | 4 +- main/compiler.ml | 115 --------------------------- main/heptc.ml | 153 ++++++++++++++++++++++++++++++++++++ main/main.ml | 100 ----------------------- minils/main/mls2seq.ml | 2 + minils/main/mls_compiler.ml | 5 -- 6 files changed, 157 insertions(+), 222 deletions(-) delete mode 100644 main/compiler.ml create mode 100644 main/heptc.ml delete mode 100644 main/main.ml diff --git a/heptagon/main/heptcheck.ml b/heptagon/main/heptcheck.ml index cc5e4f3..5bb8541 100644 --- a/heptagon/main/heptcheck.ml +++ b/heptagon/main/heptcheck.ml @@ -46,7 +46,7 @@ let compile_impl modname filename = end; (* Call the compiler*) - Hept_compiler.compile_impl pp p; + let p = Hept_compiler.compile_impl pp p in if !verbose then begin @@ -78,7 +78,7 @@ let compile_interface modname filename = let l = Scoping.translate_interface l in (* Call the compiler*) - Hept_compiler.compile_interface l; + let l = Hept_compiler.compile_interface l in Modules.write itc; diff --git a/main/compiler.ml b/main/compiler.ml deleted file mode 100644 index 47e4f77..0000000 --- a/main/compiler.ml +++ /dev/null @@ -1,115 +0,0 @@ -(**************************************************************************) -(* *) -(* Heptagon *) -(* *) -(* Author : Marc Pouzet *) -(* Organization : Demons, LRI, University of Paris-Sud, Orsay *) -(* *) -(**************************************************************************) -(* $Id$ *) - -open Location -open Misc -open Compiler_utils - -let parse_implementation lexbuf = - parse Parser.program Lexer.token lexbuf - -let parse_interface lexbuf = - parse Parser.interface Lexer.token lexbuf - -let interface modname filename = - (* input and output files *) - let source_name = filename ^ ".epi" - and obj_interf_name = filename ^ ".epci" in - - let ic = open_in source_name - and itc = open_out_bin obj_interf_name in - let close_all_files () = - close_in ic; - close_out itc in - - try - Location.initialize source_name ic; - Modules.initialize modname; - Initial.initialize (); - - (* Parsing of the file *) - let lexbuf = Lexing.from_channel ic in - let l = parse_interface lexbuf in - - (* Convert the parse tree to Heptagon AST *) - let l = Scoping.translate_interface l in - - Interface.Type.main l; - Modules.write itc; - if !print_types then Interface.Printer.print stdout; - close_all_files () - with - | x -> close_all_files (); raise x - -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 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 obc = open_out obc_name - and mlc = open_out ml_name in - - let close_all_files () = - close_in ic; - close_out itc; - close_out mlsc; - close_out obc; - close_out mlc in - - try - init_compiler modname source_name ic; - - let pp = Printer.print stdout in - - (* 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; - - (* Process the Heptagon AST *) - Hept_compiler.compile pp p; - - (* Compile Heptagon to MinilLs *) - let p = Hep2mls.program p; - - let pp = Minils.Printer.print stdout in - if !verbose then comment "Translation into MiniLs"; - Minils.Printer.print mlsc p; - - (* Process the MiniLs AST *) - Mls_compiler.compile pp p; - - (* 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 - if !verbose then pp o; - - (* Translation into dataflow and sequential languages *) - targets filename p o !target_languages; - - close_all_files (); - - with x -> close_all_files (); raise x diff --git a/main/heptc.ml b/main/heptc.ml new file mode 100644 index 0000000..54902fd --- /dev/null +++ b/main/heptc.ml @@ -0,0 +1,153 @@ +(**************************************************************************) +(* *) +(* Heptagon *) +(* *) +(* Author : Marc Pouzet *) +(* Organization : Demons, LRI, University of Paris-Sud, Orsay *) +(* *) +(**************************************************************************) +(* the main *) + +open Misc +open Compiler_utils + +let parse_implementation lexbuf = + parse Parser.program Lexer.token lexbuf + +let parse_interface lexbuf = + parse Parser.interface Lexer.token lexbuf + +let interface modname filename = + (* input and output files *) + let source_name = filename ^ ".epi" + and obj_interf_name = filename ^ ".epci" in + + let ic = open_in source_name + and itc = open_out_bin obj_interf_name in + let close_all_files () = + close_in ic; + close_out itc in + + try + init_compiler modname source_name ic; + + (* Parsing of the file *) + let lexbuf = Lexing.from_channel ic in + let l = parse_interface lexbuf in + + (* Convert the parse tree to Heptagon AST *) + let l = Scoping.translate_interface l in + + (* Call the compiler*) + let l = Hept_compiler.compile_interface l in + + Modules.write itc; + + close_all_files () + with + | x -> close_all_files (); raise x + +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 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 obc = open_out obc_name + and mlc = open_out ml_name in + + let close_all_files () = + close_in ic; + close_out itc; + close_out mlsc; + close_out obc; + close_out mlc in + + try + init_compiler modname source_name ic; + + let pp = Printer.print stdout in + + (* 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; + + (* Process the Heptagon AST *) + let p = Hept_compiler.compile_impl pp p in + + (* Compile Heptagon to MiniLS *) + let p = Hept2mls.program p in + + let pp = Minils_printer.print stdout in + if !verbose then comment "Translation into MiniLs"; + Minils_printer.print mlsc p; + + (* Process the MiniLS AST *) + let p = Mls_compiler.compile pp p in + + (* 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 + if !verbose then pp o; + + (* Translation into dataflow and sequential languages *) + Mls2seq.targets filename p o !target_languages; + + close_all_files () + + with + | x -> close_all_files (); raise x + +let compile file = + if Filename.check_suffix file ".ept" + then + let filename = Filename.chop_suffix file ".ept" in + let modname = String.capitalize(Filename.basename filename) in + compile modname filename + else if Filename.check_suffix file ".epi" + then + let filename = Filename.chop_suffix file ".epi" in + let modname = String.capitalize(Filename.basename filename) in + interface modname filename + else + raise (Arg.Bad ("don't know what to do with " ^ file)) + +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/main/main.ml b/main/main.ml deleted file mode 100644 index 15273c9..0000000 --- a/main/main.ml +++ /dev/null @@ -1,100 +0,0 @@ -(**************************************************************************) -(* *) -(* Heptagon *) -(* *) -(* Author : Marc Pouzet *) -(* Organization : Demons, LRI, University of Paris-Sud, Orsay *) -(* *) -(**************************************************************************) -(* the main *) - -(* $Id$ *) - -open Misc -open Compiler - -let compile file = - if Filename.check_suffix file ".ept" - then - let filename = Filename.chop_suffix file ".ept" in - let modname = String.capitalize(Filename.basename filename) in - compile modname filename - else if Filename.check_suffix file ".epi" - then - let filename = Filename.chop_suffix file ".epi" in - let modname = String.capitalize(Filename.basename filename) in - interface modname filename - else - raise (Arg.Bad ("don't know what to do with " ^ 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_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, c-old," - ^ " vhdl_seq, vhdl_df,\n\t\t\t java, caml 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_boolean = "\t\tTranslate enumerated values towards boolean vectors" -and doc_deadcode = "\t\tDeadcode removal" -and doc_noinit = "\t\tDisable initialization analysis" -and doc_cse = "\t\t\tPerform common sub-expression elimination" -and doc_tomato = "\t\tPerform auTOMATa minimizatiOn" -and doc_sigali = "\t\t\tGenerate symbolic equations for Sigali (Z/3Z format)" -and doc_flatten = "\tRecursively inline all calls in specified node" -and doc_inline = "\tInline the list of nodes, separated by commas" -and doc_dep2dot = "\tOutput to .dot files the dependency graph of " - ^ "the list of nodes, separated by commas" -and doc_intermediate = "\t\tPerform intermediate-equations removal (buggy)" -and doc_nomemalloc = "\t\tDisable memory allocation algorithm" -and doc_interfscheduler = "\tUse the new scheduler, that tries to minimise interference" -and doc_main_node = "\t\tUse as the toplevel node" -and doc_new_reset = "\t\tUse the new alternate encoding of resets" - -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; - "-bool", Arg.Set boolean, doc_boolean; - "-deadcode", Arg.Set deadcode, doc_deadcode; - "-noinit", Arg.Clear init, doc_noinit; - "-fti", Arg.Set full_type_info, doc_full_type_info; - "-cse", Arg.Set cse, doc_cse; - "-tomato", Arg.Set tomato, doc_tomato; - "-z3z", Arg.Unit set_sigali, doc_sigali; - "-inter", Arg.Set intermediate, doc_intermediate; - "-flatten", Arg.String (fun s -> node_to_flatten := Some s), doc_flatten; - ("-inline", - Arg.String (fun s -> nodes_to_inline := Misc.split_string s ','), - doc_inline); - ("-dep2dot", - Arg.String (fun s -> nodes_to_display := Misc.split_string s ','), - doc_dep2dot); - "-nomemalloc", Arg.Set no_mem_alloc, doc_nomemalloc; - "-interfscheduler", Arg.Set use_interf_scheduler, doc_interfscheduler; - "-new-reset-encoding", Arg.Set use_new_reset_encoding, doc_new_reset; - ] - compile - errmsg; - with - | Misc.Error -> exit 2;; - -main () diff --git a/minils/main/mls2seq.ml b/minils/main/mls2seq.ml index cdb6829..0c0af4b 100644 --- a/minils/main/mls2seq.ml +++ b/minils/main/mls2seq.ml @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Compiler_utils + (** Generation of a dataflow target *) let dataflow_target filename p target_languages = let rec one_target = function diff --git a/minils/main/mls_compiler.ml b/minils/main/mls_compiler.ml index 9e8526e..5fcd43e 100644 --- a/minils/main/mls_compiler.ml +++ b/minils/main/mls_compiler.ml @@ -13,11 +13,6 @@ 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