driver/compile.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* The batch compiler *)
  16
  17 open Misc
  18 open Config
  19 open Format
  20 open Typedtree
  21
  22 (* Initialize the search path.
  23    The current directory is always searched first,
  24    then the directories specified with the -I option (in command-line order),
  25    then the standard library directory (unless the -nostdlib option is given).
  26  *)
  27
  28 let init_path () =
  29   let dirs =
  30     if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
  31     else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs
  32     else !Clflags.include_dirs in
  33   let exp_dirs =
  34     List.map (expand_directory Config.standard_library) dirs in
  35   load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
  36   Env.reset_cache ()
  37
  38 (* Return the initial environment in which compilation proceeds. *)
  39
  40 (* Note: do not do init_path() in initial_env, this breaks
  41    toplevel initialization (PR#1775) *)
  42 let initial_env () =
  43   Ident.reinit();
  44   try
  45     if !Clflags.nopervasives
  46     then Env.initial
  47     else Env.open_pers_signature "Pervasives" Env.initial
  48   with Not_found ->
  49     fatal_error "cannot open pervasives.cmi"
  50
  51 (* Compile a .mli file *)
  52
  53 let interface ppf sourcefile outputprefix =
  54   init_path ();
  55   let modulename =
  56     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
  57   Env.set_unit_name modulename;
  58   let inputfile = Pparse.preprocess sourcefile in
  59   try
  60     let ast =
  61       Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  62     if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  63     let sg = Typemod.transl_signature (initial_env()) ast in
  64     if !Clflags.print_types then
  65       fprintf std_formatter "%a@." Printtyp.signature
  66                                    (Typemod.simplify_signature sg);
  67     Warnings.check_fatal ();
  68     if not !Clflags.print_types then
  69       Env.save_signature sg modulename (outputprefix ^ ".cmi");
  70     Pparse.remove_preprocessed inputfile
  71   with e ->
  72     Pparse.remove_preprocessed_if_ast inputfile;
  73     raise e
  74
  75 (* Compile a .ml file *)
  76
  77 let print_if ppf flag printer arg =
  78   if !flag then fprintf ppf "%a@." printer arg;
  79   arg
  80
  81 let (++) x f = f x
  82
  83 let implementation ppf sourcefile outputprefix =
  84   init_path ();
  85   let modulename =
  86     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
  87   Env.set_unit_name modulename;
  88   let inputfile = Pparse.preprocess sourcefile in
  89   let env = initial_env() in
  90   if !Clflags.print_types then begin
  91     try ignore(
  92       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  93       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  94       ++ Typemod.type_implementation sourcefile outputprefix modulename env)
  95     with x ->
  96       Pparse.remove_preprocessed_if_ast inputfile;
  97       raise x
  98   end else begin
  99     let objfile = outputprefix ^ ".cmo" in
 100     let oc = open_out_bin objfile in
 101     try
 102       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
 103       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
 104       ++ Unused_var.warn ppf
 105       ++ Typemod.type_implementation sourcefile outputprefix modulename env
 106       ++ Translmod.transl_implementation modulename
 107       ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
 108       ++ Simplif.simplify_lambda
 109       ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
 110       ++ Bytegen.compile_implementation modulename
 111       ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
 112       ++ Emitcode.to_file oc modulename;
 113       Warnings.check_fatal ();
 114       Pparse.remove_preprocessed inputfile;
 115       close_out oc;
 116     with x ->
 117       close_out oc;
 118       remove_file objfile;
 119       Pparse.remove_preprocessed_if_ast inputfile;
 120       raise x
 121   end
 122
 123 let c_file name =
 124   if Ccomp.compile_file name <> 0 then exit 2