l4/pkg/ocaml/ocaml/contrib/driver/optmain.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 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: optmain.ml 9084 2008-10-15 08:48:51Z xleroy $ *)
  14
  15 open Config
  16 open Clflags
  17
  18 let output_prefix name =
  19   let oname =
  20     match !output_name with
  21     | None -> name
  22     | Some n -> if !compile_only then (output_name := None; n) else name in
  23   Misc.chop_extension_if_any oname
  24
  25 let process_interface_file ppf name =
  26   Optcompile.interface ppf name (output_prefix name)
  27
  28 let process_implementation_file ppf name =
  29   let opref = output_prefix name in
  30   Optcompile.implementation ppf name opref;
  31   objfiles := (opref ^ ".cmx") :: !objfiles
  32
  33 let process_file ppf name =
  34   if Filename.check_suffix name ".ml"
  35   || Filename.check_suffix name ".mlt" then
  36     process_implementation_file ppf name
  37   else if Filename.check_suffix name !Config.interface_suffix then begin
  38     let opref = output_prefix name in
  39     Optcompile.interface ppf name opref;
  40     if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
  41   end
  42   else if Filename.check_suffix name ".cmx"
  43        || Filename.check_suffix name ".cmxa" then
  44     objfiles := name :: !objfiles
  45   else if Filename.check_suffix name ".cmi" && !make_package then
  46     objfiles := name :: !objfiles
  47   else if Filename.check_suffix name ext_obj
  48        || Filename.check_suffix name ext_lib then
  49     ccobjs := name :: !ccobjs
  50   else if Filename.check_suffix name ".c" then begin
  51     Optcompile.c_file name;
  52     ccobjs := (Filename.chop_suffix (Filename.basename name) ".c" ^ ext_obj)
  53               :: !ccobjs
  54   end
  55   else
  56     raise(Arg.Bad("don't know what to do with " ^ name))
  57
  58 let print_version_and_library () =
  59   print_string "The Objective Caml native-code compiler, version ";
  60   print_string Config.version; print_newline();
  61   print_string "Standard library directory: ";
  62   print_string Config.standard_library; print_newline();
  63   exit 0
  64
  65 let print_version_string () =
  66   print_string Config.version; print_newline(); exit 0
  67
  68 let print_standard_library () =
  69   print_string Config.standard_library; print_newline(); exit 0
  70
  71 let fatal err =
  72   prerr_endline err;
  73   exit 2
  74
  75 let extract_output = function
  76   | Some s -> s
  77   | None ->
  78       fatal "Please specify the name of the output file, using option -o"
  79
  80 let default_output = function
  81   | Some s -> s
  82   | None -> Config.default_executable_name
  83
  84 let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
  85
  86 let show_config () =
  87   Config.print_config stdout;
  88   exit 0;
  89 ;;
  90
  91 let main () =
  92   native_code := true;
  93   let ppf = Format.err_formatter in
  94   try
  95     Arg.parse (Arch.command_line_options @ [
  96        "-a", Arg.Set make_archive, " Build a library";
  97        "-annot", Arg.Set annotations,
  98              " Save information in <filename>.annot";
  99        "-c", Arg.Set compile_only, " Compile only (do not link)";
 100        "-cc", Arg.String(fun s -> c_compiler := Some s),
 101              "<comp>  Use <comp> as the C compiler and linker";
 102        "-cclib", Arg.String(fun s ->
 103                               ccobjs := Misc.rev_split_words s @ !ccobjs),
 104              "<opt>  Pass option <opt> to the C linker";
 105        "-ccopt", Arg.String(fun s -> ccopts := s :: !ccopts),
 106              "<opt>  Pass option <opt> to the C compiler and linker";
 107        "-compact", Arg.Clear optimize_for_speed,
 108              " Optimize code size rather than speed";
 109        "-config", Arg.Unit show_config,
 110              " print configuration values and exit";
 111        "-dtypes", Arg.Set annotations,
 112              " (deprecated) same as -annot";
 113        "-for-pack", Arg.String (fun s -> for_package := Some s),
 114              "<ident>  Generate code that can later be `packed' with\n\
 115          \     ocamlopt -pack -o <ident>.cmx";
 116        "-g", Arg.Set debug,
 117              " Record debugging information for exception backtrace";
 118        "-i", Arg.Unit (fun () -> print_types := true; compile_only := true),
 119              " Print inferred interface";
 120        "-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs),
 121              "<dir>  Add <dir> to the list of include directories";
 122        "-impl", Arg.String (process_implementation_file ppf),
 123              "<file>  Compile <file> as a .ml file";
 124        "-inline", Arg.Int(fun n -> inline_threshold := n * 8),
 125              "<n>  Set aggressiveness of inlining to <n>";
 126        "-intf", Arg.String (process_interface_file ppf),
 127              "<file>  Compile <file> as a .mli file";
 128        "-intf-suffix", Arg.String (fun s -> Config.interface_suffix := s),
 129              "<file>  Suffix for interface files (default: .mli)";
 130        "-intf_suffix", Arg.String (fun s -> Config.interface_suffix := s),
 131              "<file>  (deprecated) same as -intf-suffix";
 132        "-labels", Arg.Clear classic, " Use commuting label mode";
 133        "-linkall", Arg.Set link_everything,
 134              " Link all modules, even unused ones";
 135        "-noassert", Arg.Set noassert, " Don't compile assertion checks";
 136        "-noautolink", Arg.Set no_auto_link,
 137              " Don't automatically link C libraries specified in .cmxa files";
 138        "-nodynlink", Arg.Clear dlcode,
 139              " Enable optimizations for code that will not be dynlinked";
 140        "-nolabels", Arg.Set classic, " Ignore non-optional labels in types";
 141        "-nostdlib", Arg.Set no_std_include,
 142            " do not add standard directory to the list of include directories";
 143        "-o", Arg.String(fun s -> output_name := Some s),
 144              "<file>  Set output file name to <file>";
 145        "-output-obj", Arg.Unit(fun () -> output_c_object := true),
 146              " Output a C object file instead of an executable";
 147        "-p", Arg.Set gprofile,
 148              " Compile and link with profiling support for \"gprof\"\n\
 149          \     (not supported on all platforms)";
 150        "-pack", Arg.Set make_package,
 151               " Package the given .cmx files into one .cmx";
 152        "-pp", Arg.String(fun s -> preprocessor := Some s),
 153              "<command>  Pipe sources through preprocessor <command>";
 154        "-principal", Arg.Set principal,
 155              " Check principality of type inference";
 156        "-rectypes", Arg.Set recursive_types,
 157              " Allow arbitrary recursive types";
 158        "-shared", Arg.Unit (fun () -> shared := true; dlcode := true),
 159              " Produce a dynlinkable plugin";
 160        "-S", Arg.Set keep_asm_file, " Keep intermediate assembly file";
 161        "-thread", Arg.Set use_threads,
 162              " Generate code that supports the system threads library";
 163        "-unsafe", Arg.Set fast,
 164              " No bounds checking on array and string access";
 165        "-v", Arg.Unit print_version_and_library,
 166              " Print compiler version and standard library location and exit";
 167        "-version", Arg.Unit print_version_string,
 168              " Print compiler version and exit";
 169        "-verbose", Arg.Set verbose, " Print calls to external commands";
 170        "-w", Arg.String (Warnings.parse_options false),
 171              "<flags>  Enable or disable warnings according to <flags>:\n\
 172          \032    C/c enable/disable suspicious comment\n\
 173          \032    D/d enable/disable deprecated features\n\
 174          \032    E/e enable/disable fragile match\n\
 175          \032    F/f enable/disable partially applied function\n\
 176          \032    L/l enable/disable labels omitted in application\n\
 177          \032    M/m enable/disable overriden methods\n\
 178          \032    P/p enable/disable partial match\n\
 179          \032    S/s enable/disable non-unit statement\n\
 180          \032    U/u enable/disable unused match case\n\
 181          \032    V/v enable/disable overriden instance variables\n\
 182          \032    Y/y enable/disable suspicious unused variables\n\
 183          \032    Z/z enable/disable all other unused variables\n\
 184          \032    X/x enable/disable all other warnings\n\
 185          \032    A/a enable/disable all warnings\n\
 186          \032    default setting is \"Aelz\"";
 187        "-warn-error" , Arg.String (Warnings.parse_options true),
 188         "<flags>  Treat the warnings of <flags> as errors, if they are\n\
 189          \     enabled.  See option -w for the list of flags.\n\
 190          \     Default setting is \"a\" (warnings are not errors)";
 191        "-where", Arg.Unit print_standard_library,
 192          " Print location of standard library and exit";
 193
 194        "-nopervasives", Arg.Set nopervasives, " (undocumented)";
 195        "-dparsetree", Arg.Set dump_parsetree, " (undocumented)";
 196        "-drawlambda", Arg.Set dump_rawlambda, " (undocumented)";
 197        "-dlambda", Arg.Set dump_lambda, " (undocumented)";
 198        "-dcmm", Arg.Set dump_cmm, " (undocumented)";
 199        "-dsel", Arg.Set dump_selection, " (undocumented)";
 200        "-dcombine", Arg.Set dump_combine, " (undocumented)";
 201        "-dlive", Arg.Unit(fun () -> dump_live := true;
 202                                     Printmach.print_live := true),
 203              " (undocumented)";
 204        "-dspill", Arg.Set dump_spill, " (undocumented)";
 205        "-dsplit", Arg.Set dump_split, " (undocumented)";
 206        "-dinterf", Arg.Set dump_interf, " (undocumented)";
 207        "-dprefer", Arg.Set dump_prefer, " (undocumented)";
 208        "-dalloc", Arg.Set dump_regalloc, " (undocumented)";
 209        "-dreload", Arg.Set dump_reload, " (undocumented)";
 210        "-dscheduling", Arg.Set dump_scheduling, " (undocumented)";
 211        "-dlinear", Arg.Set dump_linear, " (undocumented)";
 212        "-dstartup", Arg.Set keep_startup_file, " (undocumented)";
 213        "-", Arg.String (process_file ppf),
 214             "<file>  Treat <file> as a file name (even if it starts with `-')"
 215       ]) (process_file ppf) usage;
 216     if
 217       List.length (List.filter (fun x -> !x)
 218                      [make_archive;make_package;shared;compile_only;output_c_object]) > 1
 219     then
 220       fatal "Please specify at most one of -pack, -a, -shared, -c, -output-obj";
 221     if !make_archive then begin
 222       Optcompile.init_path();
 223       let target = extract_output !output_name in
 224       Asmlibrarian.create_archive (List.rev !objfiles) target;
 225     end
 226     else if !make_package then begin
 227       Optcompile.init_path();
 228       let target = extract_output !output_name in
 229       Asmpackager.package_files ppf (List.rev !objfiles) target;
 230     end
 231     else if !shared then begin
 232       Optcompile.init_path();
 233       let target = extract_output !output_name in
 234       Asmlink.link_shared ppf (List.rev !objfiles) target;
 235     end
 236     else if not !compile_only && !objfiles <> [] then begin
 237       let target =
 238         if !output_c_object then
 239           let s = extract_output !output_name in
 240           if (Filename.check_suffix s Config.ext_obj
 241             || Filename.check_suffix s Config.ext_dll)
 242           then s
 243           else
 244             fatal
 245               (Printf.sprintf
 246                  "The extension of the output file must be %s or %s"
 247                  Config.ext_obj Config.ext_dll
 248               )
 249         else
 250           default_output !output_name
 251       in
 252       Optcompile.init_path();
 253       Asmlink.link ppf (List.rev !objfiles) target
 254     end;
 255     exit 0
 256   with x ->
 257     Opterrors.report_error ppf x;
 258     exit 2
 259
 260 let _ = main ()