(**********************************************************************)
(* (c) Greg Morrisett, Neal Glew, Chris Hawblitzel,                   *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

open Talout;;
open Gcd;;

exception Exit

type code_gen = CgStack | CgReg
let code_gen = ref CgStack

let pop_front_end filename =
  try
    let ic = open_in filename in
    let lb = Lexing.from_channel ic in
    Poperrhandle.set_filename filename true;
    try
      let decls = Popparse.top Poplex.token lb in
      Poptype.type_check decls
    with 
      Poperr.CompilerError (e,loc) ->
 	Poperrhandle.signal_error e loc; close_in ic; raise Exit
    | exn -> close_in ic; raise exn
  with 
    Sys_error str ->
      Printf.eprintf "%s: %s\n" filename str; flush stderr; raise Exit
  | Parsing.Parse_error -> raise Exit
;;

let compile_pop_file filename basename modname =
  let talfile = basename ^ ".tal" in
  let impfile = basename ^ "_i.tali" in
  let expfile = basename ^ "_e.tali" in
  let objectfile = basename ^ object_file_suffix in
  Printf.printf "Compiling file: %s\n" basename; flush stdout;
  try
    let popmod = pop_front_end filename in
    let (implementation,imports,exports) =
      match !code_gen with
	CgStack ->
	  Popcompile.code_gen    modname impfile expfile popmod 
      |	CgReg ->
          Popcompilereg.code_gen modname impfile expfile popmod in
    Talout.write_int (modname^"_i") impfile imports;
    Talout.write_int (modname^"_e") expfile exports;
    Talout.write_imp modname talfile implementation;
    Talout.verify talfile;
    if assemble_p () then begin
      Talout.asm talfile (Some objectfile);
      add_object_file objectfile
    end
  with Exit -> set_assemble_only ()
;;

let do_link _ libraries executable =
  add_object_file ("stdlib"^object_file_suffix);
  add_object_file ("pop_runtime"^object_file_suffix);
  Talout.link (get_object_files ()) executable
;;

let toolname = "popcorn";;
set_tooldesc "popcorn: A safe C subset compiler";;

let options =
  std_options @ 
  ["--no-opt",     Arg.Clear Popcompilereg.optimize, "don't optimize";
   "--no-regalloc",Arg.Clear Popcompilereg.allocateregs,
                                            "don't register allocate";
   "--stack-codegen", Arg.Unit (fun () -> code_gen := CgStack), 
    "use stack-based code generator";
   "--reg-codegen",   Arg.Unit (fun () -> code_gen := CgReg),
    "use register allocator"]
;;

let file_types = [".pop",compile_pop_file] @ std_file_types;;

let main () = driver toolname options file_types do_link;;

Printexc.catch main () ;;

(* EOF: popcorn.ml *)
