mpri-funcprog-project/src/Main.ml

110 lines
2.8 KiB
OCaml
Raw Normal View History

2017-12-13 14:04:28 +01:00
(* -------------------------------------------------------------------------- *)
(* Parse the command line. *)
let debug =
ref false
2018-02-15 22:19:14 +01:00
let light_debug =
ref false
2017-12-13 14:04:28 +01:00
let filenames =
ref []
let record filename =
filenames := filename :: !filenames
let options =
Arg.align [
"--debug", Arg.Set debug, " Enable debugging output";
2018-02-15 22:19:14 +01:00
"--light-debug", Arg.Set light_debug, " Enable debugging output";
2017-12-13 14:04:28 +01:00
]
let usage =
Printf.sprintf "Usage: %s <options> <filename>" Sys.argv.(0)
let () =
Arg.parse options record usage
let debug =
!debug
2018-02-15 22:19:14 +01:00
let light_debug =
!light_debug
2017-12-13 14:04:28 +01:00
let filenames =
List.rev !filenames
(* -------------------------------------------------------------------------- *)
(* Printing a syntax tree in an intermediate language (for debugging). *)
let print_delimiter () =
Printf.eprintf "----------------------------------------";
Printf.eprintf "----------------------------------------\n"
2018-02-15 22:19:14 +01:00
let dump (phase : string) (show : 'term -> string) (light: bool) (t : 'term) =
if debug || (light_debug && light) then begin
2017-12-13 14:04:28 +01:00
print_delimiter();
Printf.eprintf "%s:\n\n%s\n\n%!" phase (show t)
end;
t
(* -------------------------------------------------------------------------- *)
(* Reading and parsing a file. *)
let read filename : RawLambda.term =
try
let contents = Utils.file_get_contents filename in
let lexbuf = Lexing.from_string contents in
Error.set_filename lexbuf filename;
try
Parser.entry Lexer.entry lexbuf
with
| Parser.Error ->
Error.error (Error.place lexbuf) "Syntax error."
with
| Sys_error msg ->
prerr_endline msg;
exit 1
(* -------------------------------------------------------------------------- *)
(* Printing the final C program on the standard output channel. *)
let output (p : C.program) : unit =
Printf.printf "#include<stdlib.h>\n";
Printf.printf "#include<stdio.h>\n";
Printf.printf "#include \"prologue.h\"\n\n";
let print_program = PrintCommon.print_program PrintC.p_decl_or_function in
let buf = Buffer.create 1024 in
PrintCommon.printf_of_pprint_pretty print_program buf p;
print_endline (Buffer.contents buf)
(* -------------------------------------------------------------------------- *)
(* The complete processing pipeline. Beautiful, isn't it? *)
let process filename =
filename
|> read
2018-02-15 22:19:14 +01:00
|> dump "RawLambda" RawLambda.show_term false
2017-12-13 14:04:28 +01:00
|> Cook.cook_term
2018-02-15 22:19:14 +01:00
|> dump "Lambda" Lambda.show_term false
2017-12-13 14:04:28 +01:00
|> CPS.cps_term
2018-02-15 22:19:14 +01:00
|> dump "Tail" Tail.show_term false
|> dump "PrettyTail" PrettyTail.show true
2017-12-13 14:04:28 +01:00
|> Defun.defun_term
2018-02-15 22:19:14 +01:00
|> dump "Top" Top.show_program false
|> dump "PrettyTop" PrettyTop.show true
2017-12-13 14:04:28 +01:00
|> Finish.finish_program
2018-02-15 22:19:14 +01:00
|> dump "C" C.show_program false
2017-12-13 14:04:28 +01:00
|> output
(* -------------------------------------------------------------------------- *)
(* The main program. *)
let () =
List.iter process filenames