driver/optcompile.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. *)
  26
  27 let init_path () =
  28   let dirs =
  29     if !Clflags.use_threads
  30     then "+threads" :: !Clflags.include_dirs
  31     else !Clflags.include_dirs in
  32   let exp_dirs =
  33     List.map (expand_directory Config.standard_library) dirs in
  34   load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
  35   Env.reset_cache ()
  36
  37 (* Return the initial environment in which compilation proceeds. *)
  38
  39 let initial_env () =
  40   Ident.reinit();
  41   try
  42     if !Clflags.nopervasives
  43     then Env.initial
  44     else Env.open_pers_signature "Pervasives" Env.initial
  45   with Not_found ->
  46     fatal_error "cannot open Pervasives.cmi"
  47
  48 (* Compile a .mli file *)
  49
  50 let interface ppf sourcefile outputprefix =
  51   init_path ();
  52   let modulename =
  53     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
  54   Env.set_unit_name modulename;
  55   let inputfile = Pparse.preprocess sourcefile in
  56   try
  57     let ast =
  58       Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  59     if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  60     let sg = Typemod.transl_signature (initial_env()) ast in
  61     if !Clflags.print_types then
  62       fprintf std_formatter "%a@." Printtyp.signature
  63                                    (Typemod.simplify_signature sg);
  64     Warnings.check_fatal ();
  65     if not !Clflags.print_types then
  66       Env.save_signature sg modulename (outputprefix ^ ".cmi");
  67     Pparse.remove_preprocessed inputfile
  68   with e ->
  69     Pparse.remove_preprocessed_if_ast inputfile;
  70     raise e
  71
  72 (* Compile a .ml file *)
  73
  74 let print_if ppf flag printer arg =
  75   if !flag then fprintf ppf "%a@." printer arg;
  76   arg
  77
  78 let (++) x f = f x
  79 let (+++) (x, y) f = (x, f y)
  80
  81 let implementation ppf sourcefile outputprefix =
  82   init_path ();
  83   let modulename =
  84     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
  85   Env.set_unit_name modulename;
  86   let inputfile = Pparse.preprocess sourcefile in
  87   let env = initial_env() in
  88   Compilenv.reset ?packname:!Clflags.for_package modulename;
  89   try
  90     if !Clflags.print_types then ignore(
  91       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  92       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  93       ++ Unused_var.warn ppf
  94       ++ Typemod.type_implementation sourcefile outputprefix modulename env)
  95     else begin
  96       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  97       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  98       ++ Unused_var.warn ppf
  99       ++ Typemod.type_implementation sourcefile outputprefix modulename env
 100       ++ Translmod.transl_store_implementation modulename
 101       +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
 102       +++ Simplif.simplify_lambda
 103       +++ print_if ppf Clflags.dump_lambda Printlambda.lambda
 104       ++ Asmgen.compile_implementation outputprefix ppf;
 105       Compilenv.save_unit_info (outputprefix ^ ".cmx");
 106     end;
 107     Warnings.check_fatal ();
 108     Pparse.remove_preprocessed inputfile
 109   with x ->
 110     Pparse.remove_preprocessed_if_ast inputfile;
 111     raise x
 112
 113 let c_file name =
 114   if Ccomp.compile_file name <> 0 then exit 2