119 lines
3.4 KiB
OCaml
119 lines
3.4 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Heptagon *)
|
|
(* *)
|
|
(* Author : Marc Pouzet *)
|
|
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
open Misc
|
|
open Location
|
|
open Compiler_utils
|
|
open Mls2seq
|
|
|
|
let pp = Mls_printer.print stdout
|
|
|
|
|
|
let parse parsing_fun lexing_fun lexbuf =
|
|
try
|
|
parsing_fun lexing_fun lexbuf
|
|
with
|
|
| Mls_lexer.Lexical_error(err, pos1, pos2) ->
|
|
lexical_error err (Loc(pos1, pos2))
|
|
| Mls_parser.Error ->
|
|
let pos1 = Lexing.lexeme_start lexbuf
|
|
and pos2 = Lexing.lexeme_end lexbuf in
|
|
let l = Loc(pos1,pos2) in
|
|
syntax_error l
|
|
|
|
|
|
let parse_implementation lexbuf =
|
|
parse Mls_parser.program Mls_lexer.token lexbuf
|
|
|
|
let compile_impl modname filename =
|
|
(* input and output files *)
|
|
(* input and output files *)
|
|
let source_name = filename ^ ".mls"
|
|
and mls_norm_name = filename ^ "_norm.mls"
|
|
and obc_name = filename ^ ".obc" in
|
|
|
|
let ic, lexbuf = lexbuf_from_file source_name in
|
|
and mlsnc = open_out mls_norm_name
|
|
and obc = open_out obc_name in
|
|
|
|
let close_all_files () =
|
|
close_in ic;
|
|
close_out obc;
|
|
close_out mlsnc
|
|
in
|
|
|
|
try
|
|
init_compiler modname;
|
|
|
|
(* Parsing of the file *)
|
|
let p = parse_implementation lexbuf in
|
|
if !verbose
|
|
then begin
|
|
comment "Parsing";
|
|
pp p
|
|
end;
|
|
|
|
(* Call the compiler*)
|
|
let p = Mls_compiler.compile pp p in
|
|
|
|
if !verbose
|
|
then begin
|
|
comment "Checking"
|
|
end;
|
|
|
|
(* Producing Object-based code *)
|
|
let o = Mls2obc.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;
|
|
|
|
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 ".mls" 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;
|
|
"-assert", Arg.String add_assert, doc_assert;
|
|
"-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 ()
|