(*
   main.ml
   15-411
   by Roland Flury
*)
(* @version $Id: main.ml,v 1.6 2004/11/02 00:54:08 ajo Exp $ *)

(* Flags, set by the command-line arguments *)
let pretty_print_AST = ref false in
let dump_AST = ref false in
let print_ir = ref false in
let print_assem = ref false in
let print_ig = ref false in

let infile = ref "" in
let setinfile = ref false in
let arg_name s = infile := s; setinfile := true in

let outfile = ref "" in
let setoutfile = ref false in
let readOutFile s = outfile := s; setoutfile := true in

let noCPP = ref false in
let cppFlagList = ref [] in
let cppFlag f = cppFlagList := f :: !cppFlagList in

(*
   The main function processes the command-line arguments, calls
   CPP, then compiles the source-code and writes the result to
   a |.s| file.
*)
let main argc argv =
  (try

    let speclist =
      [("-ppa",Arg.Set(pretty_print_AST),
             "     Pretty Print Abstract Syntax Tree");
       ("-da",Arg.Set(dump_AST),
            "      Dump Abstract Syntax Tree");
       ("-ir",Arg.Set(print_ir),
            "      Print IR Tree");
       ("-asm",Arg.Set(print_assem),
             "     Print Assem Instructions");
       ("-ig",Arg.Set(print_ig),
            "      Print Interference Graph");
       ("-w",Arg.Set(Errormsg.warningFlag),
           "       Enable Warnings");
       ("-o", Arg.String(readOutFile),
           "       Set the output-file");
       ("-cpp", Arg.String(cppFlag),
             "     Pass the following flag to cpp");
       ("-nocpp", Arg.Set(noCPP),
               "   Disables preprocessing the source with cpp");
       ("-debug",Arg.Set(Errormsg.debug),
               "   Enable Debug printing")] in
    let descript =
      "compile [options]* <file>" in

    (* parse the arguments *)
    let args = Array.fold_left (fun res x -> res ^ " " ^ x) "" argv in
    Arg.parse speclist arg_name args;

    (* Require an input-file *)
    if (not !setinfile) then (
      Arg.usage speclist descript;
      exit(1)
     );

    (* Create default output-file if not provided on the command line *)
    if (not !setoutfile) then (
      try
        let pos = Str.search_backward
            (Str.regexp_string ".")
            !infile
            (String.length !infile)
        in
        outfile := String.sub !infile 0 pos ^ ".s"
      with Not_found ->
        outfile := !infile ^ ".s"
     );

    (* Preprocess the code with CPP *)
    let src_file =
      if(!noCPP) then
        !infile
      else (
        if(Sys.file_exists(!infile ^ ".cpp")) then (
          Printf.eprintf ("File '%s.cpp' already exists. Overwrite? (y|n) ")
            !infile;
          Pervasives.flush Pervasives.stderr;
          let answer = String.lowercase (Pervasives.read_line ()) in
          if(String.contains answer 'n') then
            exit(1)
         );
        (* Call CPP *)
        let commandLine = "cpp " ^ !infile ^
                                 " -C -o " ^ !infile ^ ".cpp " ^
                                 (List.fold_left (fun r s -> r ^ s)
                                    "" !cppFlagList)
        in
        (* Printf.eprintf "command line to cpp is:  %s \n" commandLine; *)
        let cppOk = Sys.command commandLine in ();
        if (cppOk != 0) then (
          Printf.eprintf "cpp failed\n";
          exit(1)
         );
        (!infile ^ ".cpp")
       ) in

    (* Open the preprocessed source file *)
    let ic = open_in src_file in

    (*
       Function |close_files| is called before exiting the compiler in 
       order to close open files and remove the temporary |.cpp| file.
    *)
    let close_files () =
      close_in ic;
      if(not !noCPP) then
        let _ = Sys.command ("rm " ^ src_file) in ();
    in

    (try
      let _ = Errormsg.startFile !infile in
      let lexbuf = Lexing.from_channel ic in
      let absyntree =
        (try
          Grammar.program Lexer.token lexbuf
        with
        | Merr_parsing.Parse_error(state, tok) ->
            Errormsg.error (Lexing.lexeme_start lexbuf,
                            Lexing.lexeme_end lexbuf)
                           (Merr.get_error(state, tok));
            close_files(); exit(-1)
        ) in

      if (!pretty_print_AST) then (
        print_string "||||||||||PRETTY PRINT AST||||||||||||>\n";
        Absyn.print_ast stdout absyntree;
        print_string "<|||||||||PRETTY PRINT AST|||||||||||||\n"
      );

      let absyntree = Checker.check_program absyntree in

      if (!dump_AST) then (
        print_string "||||||||||||||DUMP AST||||||||||||||||>\n";
        Absyn.dump_ast stdout absyntree;
        print_string "<|||||||||||||DUMP AST|||||||||||||||||\n"
      );

      let irtree = Translate.trans_program absyntree in
      if (!print_ir) then Ir.print_ir irtree;
      let scheduled = Block.schedule irtree in
      let munched = Munch.munch_program scheduled in
      if (!print_assem) then Assem.print_assem munched;
      let alloced = Regalloc.regalloc (Frame.nregs, Frame.size()) munched in

      (* Open the output file. *)
      let oc = open_out (!outfile) in
      output_string oc (Finalize.finalize_prog alloced !infile);

      close_out oc;

      close_files();

    with
    | Lexer.EXIT
    | Absyn.EXIT
    | Checker.EXIT ->
        close_files(); exit(-1)
    )
  with
  | Sys_error(s) ->
      Printf.eprintf "I/O error: %s\n" s; exit(-1)
  );
  exit(0)
in

main (Array.length Sys.argv) Sys.argv;;