(* $Id: hgen_main.ml 20579 2009-03-27 17:54:33Z gerd $ *)

open Hgen_types;;

let initial_comment f name =
  Printf.fprintf f
    ("(************************************************************\n\
   \032* WARNING!\n\
   \032*\n\
   \032* This file is generated by hydrogen from the source file\n\
   \032* %s\n\
   \032*\n\
   \032************************************************************)\n%!")
    name


let main() =
  let filename = ref "" in
  let p_symtable = ref false in
  let view = ref false in
  let cpp = ref (Some "cpp") in
  let cpp_options = ref [] in

  Arg.parse
    [ "-print-symboltable", Arg.Set p_symtable,
      "  Print the symbol table after parsing";

      "-view", Arg.Set view,
      "  Only print the MLI and ML files to generate to stdout";

      "-dm", Arg.Set Hgen_trans_il.enable_directmapping,
      "  Enable that DirectMapping code is generated (faster but more code)";

      "-cpp", (Arg.String
                 (fun s ->
                    cpp := if s = "none" then None else Some s)),
      "<p> Call the command <p> as preprocessor (-cpp none disables)";

      "-D", (Arg.String (fun s -> cpp_options := !cpp_options @ [ "-D" ^ s ])),
      "var=value Define the preprocessor variable var";

      "-U", (Arg.String (fun s -> cpp_options := !cpp_options @ [ "-U" ^ s ])),
      "var Undefine the preprocessor variable var";
    ]
    (fun s ->
       filename := s
    )
    (Printf.sprintf "usage: %s [options] file.ice" (Filename.basename Sys.argv.(0)));

  if !filename = "" then
    failwith "No filename given";

  let f, close_f =
    match !cpp with
      | None ->
	  let f = open_in !filename in
	  (f, (fun () -> close_in f) )
      | Some cmd ->
          let options =
            String.concat " " (List.map Filename.quote !cpp_options) in
          let f = 
	    Unix.open_process_in (cmd ^ " " ^ options ^ " " ^ !filename) in
	  let to_close = ref true in
	  (f, (fun () -> 
		 if !to_close then (
		   let status = Unix.close_process_in f in
		   to_close := false;
		   if status <> Unix.WEXITED 0 then
		     failwith "Preprocessor failed"
		 )
	      )
	  )
  in

  let onerror = ref [close_f] in

  try
    let defs = Hgen_analyzer.parse !filename f in
    let symtab = Hgen_analyzer.analyze defs in
    close_f();

    if !p_symtable then
      Hgen_util.TS_util.print_symboltable symtab;
    
    let pad = Hgen_trans_il.to_il symtab in
    
    if !view then (
      let fmt = Format.std_formatter in
      print_string "(**********************************************************************)\n";
      print_string "(* MLI                                                                *)\n";
      print_string "(**********************************************************************)\n";
      Hgen_print_il.print_pad_sig fmt pad;
      print_string "(**********************************************************************)\n";
      print_string "(* ML                                                                 *)\n";
      print_string "(**********************************************************************)\n";
      Hgen_print_il.print_pad_impl fmt pad
    )
    else (
      let basename = Filename.chop_extension !filename in
      let mliname = basename ^ ".mli" in
      let mli = open_out mliname in
      onerror := 
	(fun () -> close_out mli; Sys.remove mliname) ::
	  !onerror;
      initial_comment mli !filename;
      let mli_fmt = Format.formatter_of_out_channel mli in
      Hgen_print_il.print_pad_sig mli_fmt pad;
      Format.pp_print_flush mli_fmt ();
      close_out mli;
      
      let mlname = basename ^ ".ml" in
      let ml = open_out mlname in
      onerror := 
	(fun () -> close_out ml; Sys.remove mlname) ::
	  !onerror;
      initial_comment ml !filename;
      let ml_fmt = Format.formatter_of_out_channel ml in
      Hgen_print_il.print_pad_impl ml_fmt pad;
      Format.pp_print_flush ml_fmt ();
      close_out ml;
    );
    close_f()
  with
    | err -> List.iter (fun f -> try f() with _ -> ()) !onerror; raise err
;;



let loc_string loc =
  Printf.sprintf "File %s, line %d, column %d"
    loc.file
    loc.line
    (loc.offset - loc.bol)
;;


try
  main()
with
  | Hgen_types.Lexical_error(loc,msg) ->
      Printf.eprintf "%s: Lexical error: %s\n%!" (loc_string loc) msg;
      exit 2
  | Hgen_types.Syntax_error loc ->
      Printf.eprintf "%s: Syntax error\n%!" (loc_string loc);
      exit 2
  | Hgen_types.Other_error(loc,msg) ->
      Printf.eprintf "%s: %s\n%!" (loc_string loc) msg;
      exit 2
  | Hgen_types.Noloc_error msg ->
      Printf.eprintf "At unknown location: %s\n%!" msg;
      exit 2
;;