(*
 Oukseh Lee

 This source is almost copied from the Objective Caml compiler.
*)


signature OCAML_COMPILE = sig
  val init_path : unit -> unit
  val initial_env : unit -> Env.t
  val implementation : Format.formatter -> (unit -> Env.t) ->
      (Lexing.lexbuf -> Parsetree.tree) -> (string -> string)
      -> string -> unit
  val parse_file: string -> (Lexing.lexbuf -> 'a) -> string -> 'a

end

functor CompileGen (X: OCAML_COMPILE) = struct

open Misc
open Config
open Format
open Typedtree
open Strtbl_build

val env_open = Env.open_pers_signature

fun initial_env () = (
    if !Clflags.ntyping then Init.init (!Clflags.include_dirs @ ["./"]);
    let val env = X.initial_env()
    in (if !Clflags.nopervasives then env
        else if !Clflags.ntyping then 
          env_open "Nml_typing_" (env_open "Nml_setmaphash_" env)
        else env_open "Nml_setmaphash_" env) 
       handle Not_found => fatal_error "cannot open nML type environment" 
    end)
  
fun implementation ppf sourcefile =
  let val prefixname = Filename.chop_extension sourcefile
      val modulename = rename (Filename.basename prefixname)
      val ntyfile = prefixname ^ ".nty"
      fun parse lb =
        let val nast = Nparse.implementation_parse lb
            val nast' = if !Clflags.ntyping then
                          let val _ = NEnv.reset_file modulename
                              val absyn = Infer.infer nast
                          in  ignore(NEnv.stabilize_file());
                              Dump.dump ntyfile;
                              Absyn2Ast.topdec (Remove_record.topdec absyn)
                          end
                        else nast
        in  N2caml.trans_topdec (Nconvert.convert_topdec (Ast2Fake.topdec nast'))
        end
  in  X.init_path();
      build_str_table sourcefile (!load_path);
      (X.implementation ppf initial_env parse rename sourcefile) 
        handle x => (remove_file ntyfile; raise x)
  end

fun compile_signature ppf sourcefile = let
  val _ = (X.init_path(); NEnv.sig_context_prefix := "")
  val prefixname = Filename.chop_extension sourcefile 
  val ntyfile = prefixname ^ ".nty"
  val env = initial_env()
  fun implementation_parse lb =
    let val nast = Nparse.implementation_parse lb
    in  if !Clflags.ntyping then (
          ignore(Infer.infer nast);
          NEnv.convert_to_str();
          Dump.dump ntyfile)
    end
  in  X.parse_file sourcefile implementation_parse ast_impl_magic_number
  end

fun create_archive files outfile = let
 val bs = List.iter (fn f => let val (b,c) = Dump.load f
                             in  NEnv.add_b b;
                                 Ty.CE.add_ce' c
                             end) files
 in  Dump.dump outfile
 end

end