merge packaging

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/poly_meth2@4415 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

23 files changed, 120 insertions, 477 deletions

diff --git a/driver/compile.ml b/driver/compile.ml
index 0699c531cb..6a3c20c669 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -22,7 +22,8 @@ open Typedtree
 (* Initialize the search path.
    The current directory is always searched first,
    then the directories specified with the -I option (in command-line order),
-   then the standard library directory. *)
+   then the standard library directory (unless the -nostdlib option is given).
+ *)
 
 let init_path () =
   let dirs =
@@ -31,7 +32,7 @@ let init_path () =
     else !Clflags.include_dirs in
   let exp_dirs =
     List.map (expand_directory Config.standard_library) dirs in
-  load_path := "" :: List.rev (Config.standard_library :: exp_dirs);
+  load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
   Env.reset_cache()
 
 (* Return the initial environment in which compilation proceeds. *)
diff --git a/driver/main.ml b/driver/main.ml
index 47192c69eb..6ee14e5c08 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -90,6 +90,7 @@ module Options = Main_args.Make_options (struct
   let _noassert = set noassert
   let _nolabels = set classic
   let _noautolink = set no_auto_link
+  let _nostdlib = set no_std_include
   let _o s = exec_name := s; archive_name := s; object_name := s
   let _output_obj () = output_c_object := true; custom_runtime := true
   let _pack = set make_package
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 4d62ab5774..0beea91e45 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -34,6 +34,7 @@ module Make_options (F :
      val _noassert : unit -> unit
      val _noautolink : unit -> unit
      val _nolabels : unit -> unit
+     val _nostdlib : unit -> unit
      val _o : string -> unit
      val _output_obj : unit -> unit
      val _pack : unit -> unit
@@ -92,6 +93,8 @@ struct
     "-noautolink", Arg.Unit F._noautolink,
            " Don't automatically link C libraries specified in .cma files";
     "-nolabels", Arg.Unit F._nolabels, " Ignore non-optional labels in types";
+    "-nostdlib", Arg.Unit F._nostdlib,
+           " do not add default directory to the list of include directories";
     "-o", Arg.String F._o, "<file>  Set output file name to <file>";
     "-output-obj", Arg.Unit F._output_obj,
            " Output a C object file instead of an executable";
diff --git a/driver/main_args.mli b/driver/main_args.mli
index dac021e056..137ed6892d 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -34,6 +34,7 @@ module Make_options (F :
       val _noassert : unit -> unit
       val _noautolink : unit -> unit
       val _nolabels : unit -> unit
+      val _nostdlib : unit -> unit
       val _o : string -> unit
       val _output_obj : unit -> unit
       val _pack : unit -> unit
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index b3302a182b..fd8f41989e 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -31,7 +31,7 @@ let init_path () =
     else !Clflags.include_dirs in
   let exp_dirs =
     List.map (expand_directory Config.standard_library) dirs in
-  load_path := "" :: List.rev (Config.standard_library :: exp_dirs);
+  load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
   Env.reset_cache()
 
 (* Return the initial environment in which compilation proceeds. *)
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 0cdaa0946c..f1a6c39bcf 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -95,6 +95,8 @@ let main () =
        "-noautolink", Arg.Set no_auto_link,
              " Don't automatically link C libraries specified in .cma files";
        "-nolabels", Arg.Set classic, " Ignore non-optional labels in types";
+       "-nostdlib", Arg.Set no_std_include,
+           " do not add standard directory to the list of include directories";
        "-o", Arg.String(fun s -> exec_name := s;
                                  archive_name := s;
                                  object_name := s),
@@ -108,7 +110,7 @@ let main () =
               " Package the given .cmo files into one .cmo";
        "-pp", Arg.String(fun s -> preprocessor := Some s),
              "<command>  Pipe sources through preprocessor <command>";
-       "-principal", Arg.set principal,
+       "-principal", Arg.Set principal,
              " Check principality of type inference";
        "-rectypes", Arg.Set recursive_types,
              " Allow arbitrary recursive types";
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 724aaabf8f..bc26ada1b3 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -18,10 +18,10 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
-COMPFLAGS=-g -warn-error A
+COMPFLAGS=-g -warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
-OPTCOMPFLAGS=-warn-error A
+OPTCOMPFLAGS=-warn-error A -nostdlib
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
 BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
diff --git a/stdlib/complex.ml b/stdlib/complex.ml
index 05d8910b06..fe2e0388d1 100644
--- a/stdlib/complex.ml
+++ b/stdlib/complex.ml
@@ -32,26 +32,27 @@ let conj x = { re = x.re; im = -. x.im }
 let mul x y = { re = x.re *. y.re -. x.im *. y.im;
                 im = x.re *. y.im +. x.im *. y.re }
 
-let inv x =
-  (* Watch out for overflow in computing re^2 + im^2 *)
-  if abs_float x.re >= abs_float x.im then begin
-    let q = x.im /. x.re in
-    let d = 1.0 +. q *. q in
-    { re = (1.0 /. d) /. x.re; im = -. (q /. d) /. x.re }
-  end else begin
-    let q = x.re /. x.im in
-    let d = 1.0 +. q *. q in
-    { re = (q /. d) /. x.im; im = (-1.0 /. d) /. x.im }
-  end
+let div x y =
+  if abs_float y.re >= abs_float y.im then
+    let r = y.im /. y.re in
+    let d = y.re +. r *. y.im in
+    { re = (x.re +. r *. x.im) /. d;
+      im = (x.im -. r *. x.re) /. d }
+  else
+    let r = y.re /. y.im in
+    let d = y.im +. r *. y.re in
+    { re = (r *. x.re +. x.im) /. d;
+      im = (r *. x.im -. x.re) /. d }
 
-let div x y = mul x (inv y)
+let inv x = div one x
 
 let norm2 x = x.re *. x.re +. x.im *. x.im
 
 let norm x =
   (* Watch out for overflow in computing re^2 + im^2 *)
   let r = abs_float x.re and i = abs_float x.im in
-  if r = 0.0 && i = 0.0 then 0.0
+  if r = 0.0 then i
+  else if i = 0.0 then r
   else if r >= i then
     let q = i /. r in r *. sqrt(1.0 +. q *. q)
   else
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index 3bcce1d0f8..a0c79976f6 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -55,14 +55,14 @@ val chop_extension : string -> string
 
 val basename : string -> string
 (** Split a file name into directory name / base file name.
-   {!Filename.concat} [(]{!Filename.dirname}[ name) (]{!Filename.basename}[ name)]
-   returns a file name which is equivalent to [name]. Moreover, after setting the
-   current directory to {!Filename.dirname}[ name] (with {!Sys.chdir}),
-   references to {!Filename.basename}[ name] (which is a relative file name)
+   [concat (dirname name) (basename name)] returns a file name
+   which is equivalent to [name]. Moreover, after setting the
+   current directory to [dirname name] (with {!Sys.chdir}),
+   references to [basename name] (which is a relative file name)
    designate the same file as [name] before the call to {!Sys.chdir}. *)
 
 val dirname : string -> string
-(** See {!Filename.dirname}. *)
+(** See {!Filename.basename}. *)
 
 val temp_file : string -> string -> string
 (** [temp_file prefix suffix] returns the name of a
@@ -83,6 +83,6 @@ val temp_file : string -> string -> string
 
 val quote : string -> string
 (** Return a quoted version of a file name, suitable for use as
-   one argument in a shell command line, escaping any shell
+   one argument in a shell command line, escaping all shell
    meta-characters. *)
 
diff --git a/tools/Makefile b/tools/Makefile
index 689d78b2d2..dd8df4f5bb 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -19,7 +19,7 @@ CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot
 CAMLLEX=$(CAMLRUN) ../boot/ocamllex
 INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
          -I ../driver
-COMPFLAGS= -warn-error A $(INCLUDES)
+COMPFLAGS= -warn-error A $(INCLUDES) -nostdlib
 LINKFLAGS=$(INCLUDES)
 
 all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib scrapelabels addlabels
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index 64b19e3227..baad2256f1 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -53,6 +53,7 @@ module Options = Main_args.Make_options (struct
   let _noassert = option "-noassert"
   let _nolabels = option "-nolabels"
   let _noautolink = option "-noautolink"
+  let _nostdlib = option "-nostdlib"
   let _o s = option_with_arg "-o" s
   let _output_obj = option "-output-obj"
   let _pack = option "-pack"
diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp
index 92711424fc..fb77cc5eaf 100644
--- a/tools/ocamlmklib.mlp
+++ b/tools/ocamlmklib.mlp
@@ -31,6 +31,7 @@ and dynlink = ref supports_shared_libraries
 and failsafe = ref false    (* whether to fall back on static build only *)
 and c_libs = ref []         (* libs to pass to mksharedlib and ocamlc -cclib *)
 and c_opts = ref []      (* options to pass to mksharedlib and ocamlc -ccopt *)
+and ld_opts = ref []        (* options to pass only to the linker *)
 and ocamlc = ref (Filename.concat bindir "ocamlc")
 and ocamlopt = ref (Filename.concat bindir "ocamlopt")
 and output = ref "a"        (* Output name for Caml part of library *)
@@ -75,6 +76,10 @@ let parse_arguments argv =
       caml_opts := next_arg () :: "-I" :: !caml_opts
     else if s = "-failsafe" then
       failsafe := true
+    else if s = "-h" || s = "-help" then
+      raise (Bad_argument "")
+    else if s = "-ldopt" then
+      ld_opts := next_arg () :: !ld_opts
     else if s = "-linkall" then
       caml_opts := s :: !caml_opts
     else if starts_with s "-l" then
@@ -115,7 +120,7 @@ let parse_arguments argv =
   List.iter
     (fun r -> r := List.rev !r)
     [ bytecode_objs; native_objs; c_objs; caml_libs; caml_opts; 
-      c_libs; c_objs; rpath ];
+      c_libs; c_objs; ld_opts; rpath ];
   if !output_c = "" then output_c := !output
 
 let usage = "\
@@ -127,6 +132,7 @@ Options are:
   -dllpath <dir> Add <dir> to the run-time search path for DLLs
   -I <dir>       Add <dir> to the path searched for Caml object files
   -failsafe      fall back to static linking if DLL construction failed
+  -ldopt <opt>   C option passed to the shared linker only
   -linkall       Build Caml archive with link-all behavior
   -l<lib>        Specify a dependent C library
   -L<dir>        Add <dir> to the path searched for C libraries
@@ -176,11 +182,12 @@ let build_libs () =
   if !c_objs <> [] then begin
     if !dynlink then begin
       let retcode = command
-        (sprintf "%s dll%s.so %s %s %s %s"
+        (sprintf "%s dll%s.so %s %s %s %s %s"
                     mksharedlib
                     !output_c
                     (String.concat " " !c_objs)
                     (String.concat " " !c_opts)
+                    (String.concat " " !ld_opts)
                     (make_rpath mksharedlib_rpath)
                     (String.concat " " !c_libs)) in
       if retcode <> 0 then if !failsafe then dynlink := false else exit 2
@@ -227,6 +234,8 @@ let _ =
     parse_arguments Sys.argv;
     build_libs()
   with
+  | Bad_argument "" ->
+      prerr_string usage; exit 0
   | Bad_argument s ->
       prerr_endline s; prerr_string usage; exit 4
   | Sys_error s ->
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index ed14136b04..dcafc639ae 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -50,7 +50,6 @@ module type S =
           int -> int ->
           (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
           Env.t -> t -> type_expr -> Outcometree.out_value
-    val print_outval : formatter -> Outcometree.out_value -> unit
   end
 
 module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
@@ -358,78 +357,4 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
 
     in tree_of_val max_depth obj ty
 
-    exception Ellipsis
-
-    let cautious f ppf arg = try f ppf arg with Ellipsis -> fprintf ppf "..."
-
-    let print_outval ppf tree =
-      let rec print_ident ppf =
-        function
-          Oide_ident s -> fprintf ppf "%s" s
-        | Oide_dot (id, s) -> fprintf ppf "%a.%s" print_ident id s
-        | Oide_apply (id1, id2) ->
-            fprintf ppf "%a(%a)" print_ident id1 print_ident id2
-      in
-      let rec print_tree ppf =
-        function
-          Oval_tuple tree_list ->
-            fprintf ppf "@[%a@]" (print_tree_list print_tree_1 ",") tree_list
-        | tree -> print_tree_1 ppf tree
-      and print_tree_1 ppf =
-        function
-          Oval_constr (name, [param]) ->
-            fprintf ppf "@[<1>%a@ %a@]" print_ident name print_simple_tree
-              param
-        | Oval_constr (name, (_ :: _ as params)) ->
-            fprintf ppf "@[<1>%a@ (%a)@]" print_ident name
-              (print_tree_list print_tree_1 ",") params
-        | Oval_variant (name, Some param) ->
-            fprintf ppf "@[<2>`%s@ %a@]" name print_simple_tree param
-        | tree -> print_simple_tree ppf tree
-      and print_simple_tree ppf =
-        function
-          Oval_int i -> fprintf ppf "%i" i
-        | Oval_float f -> fprintf ppf "%s" (string_of_float f)
-        | Oval_char c -> fprintf ppf "'%s'" (Char.escaped c)
-        | Oval_string s ->
-            (* String.escaped may raise [Invalid_argument "String.create"]
-               if the escaped string is longer than [Sys.max_string_length] *)
-            begin try
-              fprintf ppf "\"%s\"" (String.escaped s)
-            with Invalid_argument "String.create" ->
-              fprintf ppf "<huge string>"
-            end
-        | Oval_list tl ->
-            fprintf ppf "@[<1>[%a]@]" (print_tree_list print_tree_1 ";") tl
-        | Oval_array tl ->
-            fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree_1 ";") tl
-        | Oval_constr (name, []) -> print_ident ppf name
-        | Oval_variant (name, None) -> fprintf ppf "`%s" name
-        | Oval_stuff s -> fprintf ppf "%s" s
-        | Oval_record fel ->
-            fprintf ppf "@[<1>{%a}@]" (cautious (print_fields true)) fel
-        | Oval_ellipsis -> raise Ellipsis
-        | Oval_printer f -> f ppf
-        | tree -> fprintf ppf "@[<1>(%a)@]" (cautious print_tree) tree
-      and print_fields first ppf =
-        function
-          [] -> ()
-        | (name, tree) :: fields ->
-            if not first then fprintf ppf ";@ ";
-            fprintf ppf "@[<1>%a@ =@ %a@]" print_ident name
-              (cautious print_tree) tree;
-            print_fields false ppf fields
-      and print_tree_list print_item sep ppf tree_list =
-        let rec print_list first ppf =
-          function
-            [] -> ()
-          | tree :: tree_list ->
-              if not first then fprintf ppf "%s@ " sep;
-              print_item ppf tree;
-              print_list false ppf tree_list
-        in
-        cautious (print_list true) ppf tree_list
-      in
-      cautious print_tree ppf tree
-
 end
diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli
index 76b091e786..898588b2dd 100644
--- a/toplevel/genprintval.mli
+++ b/toplevel/genprintval.mli
@@ -46,7 +46,6 @@ module type S =
           int -> int ->
           (int -> t -> Types.type_expr -> Outcometree.out_value option) ->
           Env.t -> t -> type_expr -> Outcometree.out_value
-    val print_outval : formatter -> Outcometree.out_value -> unit
   end
 
 module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) :
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 5fc8bb1bb7..272caeecc2 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -77,9 +77,13 @@ module Printer = Genprintval.Make(Obj)(EvalPath)
 let max_printer_depth = ref 100
 let max_printer_steps = ref 300
 
-let print_out_value = ref Printer.print_outval
-let print_out_type = Printtyp.outcome_type
-let print_out_sig_item = Printtyp.outcome_sig_item
+let print_out_value = Oprint.out_value
+let print_out_type = Oprint.out_type
+let print_out_class_type = Oprint.out_class_type
+let print_out_module_type = Oprint.out_module_type
+let print_out_sig_item = Oprint.out_sig_item
+let print_out_signature = Oprint.out_signature
+let print_out_phrase = Oprint.out_phrase
 
 let print_untyped_exception ppf obj =
   !print_out_value ppf (Printer.outval_of_untyped_exception obj)
@@ -174,20 +178,6 @@ let rec item_list env = function
      | None -> []
      | Some (tree, valopt, items) -> (tree, valopt) :: item_list env items
 
-let rec print_items ppf =
-  function
-  | [] -> ()
-  | (tree, valopt) :: items ->
-      begin match valopt with
-      | Some v ->
-          fprintf ppf "@[<2>%a =@ %a@]" !print_out_sig_item tree
-            !print_out_value v
-      | None ->
-          fprintf ppf "@[%a@]" !print_out_sig_item tree
-      end;
-      if items <> [] then
-        fprintf ppf "@ %a" print_items items;;
-
 (* The current typing environment for the toplevel *)
 
 let toplevel_env = ref Env.empty
@@ -195,15 +185,7 @@ let toplevel_env = ref Env.empty
 (* Print an exception produced by an evaluation *)
 
 let print_out_exception ppf exn outv =
-  match exn with
-  | Sys.Break ->
-      fprintf ppf "Interrupted.@."
-  | Out_of_memory ->
-      fprintf ppf "Out of memory during evaluation.@."
-  | Stack_overflow ->
-      fprintf ppf "Stack overflow during evaluation (looping recursion?).@."
-  | _ ->
-      fprintf ppf "@[Exception:@ %a.@]@." !print_out_value outv
+  !print_out_phrase ppf (Ophr_exception (exn, outv))
 
 let print_exception_outcome ppf exn =
   if exn = Out_of_memory then Gc.full_major ();
@@ -217,17 +199,6 @@ let directive_table = (Hashtbl.create 13 : (string, directive_fun) Hashtbl.t)
 
 (* Execute a toplevel phrase *)
 
-let print_phrase ppf =
-  function
-  | Ophr_eval (outv, ty) ->
-      fprintf ppf "@[- : %a@ =@ %a@]@."
-        !print_out_type ty !print_out_value outv
-  | Ophr_signature [] -> ()
-  | Ophr_signature items -> fprintf ppf "@[<v>%a@]@." print_items items
-  | Ophr_exception (exn, outv) -> print_out_exception ppf exn outv
-
-let print_out_phrase = ref print_phrase
-
 let execute_phrase print_outcome ppf phr =
   match phr with
   | Ptop_def sstr ->
diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
index 39b4784ee4..4c3ca35d42 100644
--- a/toplevel/toploop.mli
+++ b/toplevel/toploop.mli
@@ -81,10 +81,20 @@ val print_location : formatter -> Location.t -> unit
 val print_warning : Location.t -> formatter -> Warnings.t -> unit
 val input_name : string ref
 
-val print_out_value : (formatter -> Outcometree.out_value -> unit) ref
-val print_out_type : (formatter -> Outcometree.out_type -> unit) ref
-val print_out_sig_item : (formatter -> Outcometree.out_sig_item -> unit) ref
-val print_out_phrase : (formatter -> Outcometree.out_phrase -> unit) ref
+val print_out_value :
+  (formatter -> Outcometree.out_value -> unit) ref
+val print_out_type :
+  (formatter -> Outcometree.out_type -> unit) ref
+val print_out_class_type :
+  (formatter -> Outcometree.out_class_type -> unit) ref
+val print_out_module_type :
+  (formatter -> Outcometree.out_module_type -> unit) ref
+val print_out_sig_item :
+  (formatter -> Outcometree.out_sig_item -> unit) ref
+val print_out_signature :
+  (formatter -> Outcometree.out_sig_item list -> unit) ref
+val print_out_phrase :
+  (formatter -> Outcometree.out_phrase -> unit) ref
 
 (* Used by Trace module *)
 
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 555fadde6f..ea623b29a7 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -43,6 +43,8 @@ let main () =
      "-labels", Arg.Clear classic, " Labels commute (default)";
      "-noassert", Arg.Set noassert, " Do not compile assertion checks";
      "-nolabels", Arg.Set classic, " Ignore labels and do not commute";
+     "-nostdlib", Arg.Set no_std_include,
+           " do not add default directory to the list of include directories";
      "-principal", Arg.Set principal, " Check principality of type inference";
      "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types";
      "-unsafe", Arg.Set fast, " No bound checking on array and string access";
diff --git a/typing/btype.ml b/typing/btype.ml
index 83d767d031..dd5ec5d4f6 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -286,8 +286,8 @@ let rec forget_abbrev_rec mem path =
       assert false
   | Mcons (path', _, _, rem) when Path.same path path' ->
       rem 
-  | Mcons (path, v, v', rem) ->
-      Mcons (path, v, v', forget_abbrev_rec rem path)
+  | Mcons (path', v, v', rem) ->
+      Mcons (path', v, v', forget_abbrev_rec rem path)
   | Mlink mem' ->
       mem' := forget_abbrev_rec !mem' path;
       raise Exit
diff --git a/typing/oprint.ml b/typing/oprint.ml
index e7042d124b..4a16f45a82 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -116,10 +116,20 @@ let rec print_list pr sep ppf =
 let pr_present =
   print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
 
+let pr_vars =
+  print_list (fun ppf s -> fprintf ppf "'%s" s) (fun ppf -> fprintf ppf "@ ")
+
 let rec print_out_type ppf =
   function
-    Otyp_alias (ty, s) -> fprintf ppf "@[%a as '%s@]" print_out_type ty s
-  | ty -> print_out_type_1 ppf ty
+  | Otyp_alias (ty, s) ->
+      fprintf ppf "@[%a as '%s@]" print_out_type ty s
+  | Otyp_poly (sl, ty) ->
+      fprintf ppf "@[<hov 2>%a.@ %a@]"
+        pr_vars sl
+        print_out_type ty
+  | ty ->
+      print_out_type_1 ppf ty
+
 and print_out_type_1 ppf =
   function
     Otyp_arrow (lab, ty1, ty2) ->
@@ -158,10 +168,10 @@ and print_simple_out_type ppf =
       in
       fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a]@]" (if non_gen then "_" else "")
         (if closed then if tags = None then " " else "< "
-         else if tags = None then "> "
-         else "? ")
-        print_fields row_fields print_present tags
-  | Otyp_alias (_, _) | Otyp_arrow (_, _, _) | Otyp_tuple _ as ty ->
+         else if tags = None then "> " else "? ")
+        print_fields row_fields
+        print_present tags
+  | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
       fprintf ppf "@[<1>(%a)@]" print_out_type ty
   | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
 and print_fields rest ppf =
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 919559b0bb..09c9f4c340 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -206,15 +206,6 @@ let print_labels = ref true
 let print_label ppf l =
   if !print_labels && l <> "" || is_optional l then fprintf ppf "%s:" l
 
-let rec print_list_init pr sep ppf = function
-  | [] -> ()
-  | a :: l -> sep ppf; pr ppf a; print_list_init pr sep ppf l;;
-
-let rec print_list pr sep ppf = function
-  | [] -> ()
-  | [a] -> pr ppf a
-  | a :: l -> pr ppf a; sep ppf; print_list pr sep ppf l;;
-
 let rec tree_of_typexp sch ty =
   let ty = repr ty in
   let px = proxy ty in
@@ -360,121 +351,8 @@ and tree_of_typfields sch rest = function
       let (fields, rest) = tree_of_typfields sch rest l in
       (field :: fields, rest)
 
-let rec print_ident ppf =
-  function
-  | Oide_ident s -> fprintf ppf "%s" s
-  | Oide_dot (id, s) -> fprintf ppf "%a.%s" print_ident id s
-  | Oide_apply (id1, id2) ->
-      fprintf ppf "%a(%a)" print_ident id1 print_ident id2
-
-let pr_names fmt =
-  print_list (fun ppf s -> fprintf ppf fmt s) (fun ppf -> fprintf ppf "@ ")
-
-let rec print_out_type ppf =
-  function
-  | Otyp_alias (ty, s) ->
-      fprintf ppf "@[%a as '%s@]" print_out_type ty s
-  | Otyp_poly (sl, ty) ->
-      fprintf ppf "@[<hov 2>%a.@ %a@]"
-        (pr_names "'%s") sl
-        print_out_type ty
-  | ty ->
-      print_out_type_1 ppf ty
-
-and print_out_type_1 ppf =
-  function
-  | Otyp_arrow (lab, ty1, ty2) ->
-      fprintf ppf "@[%s%a ->@ %a@]"
-        (if lab <> "" then lab ^ ":" else "")
-        print_out_type_2 ty1 print_out_type_1 ty2
-  | ty ->
-      print_out_type_2 ppf ty
-
-and print_out_type_2 ppf =
-  function
-  | Otyp_tuple tyl ->
-      fprintf ppf "@[<0>%a@]" (print_typlist print_simple_out_type " *") tyl
-  | ty ->
-      print_simple_out_type ppf ty
-
-and print_simple_out_type ppf =
-  function
-  | Otyp_class (ng, id, tyl) ->
-      fprintf ppf "@[%a%s#%a@]" print_typargs tyl
-        (if ng then "_" else "") print_ident id
-  | Otyp_constr (id, tyl) ->
-      fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id
-  | Otyp_object (fields, rest) ->
-      fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields
-  | Otyp_stuff s ->
-      fprintf ppf "%s" s
-  | Otyp_var (ng, s) ->
-      fprintf ppf "'%s%s" (if ng then "_" else "") s
-  | Otyp_variant (non_gen, row_fields, closed, tags) ->
-      let print_present ppf =
-        function
-        | None | Some [] -> ()
-        | Some l -> fprintf ppf "@;<1 -2>> @[<hov>%a@]" (pr_names "`%s") l
-      in
-      let print_fields ppf = function
-          Ovar_fields fields ->
-            print_list print_row_field (fun ppf -> fprintf ppf "@;<1 -2>| ")
-              ppf fields
-        | Ovar_name (id, tyl) ->
-            fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id
-      in
-      fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a]@]"
-        (if non_gen then "_" else "")
-        (if closed then if tags = None then " " else "< "
-         else if tags = None then "> " else "? ")
-        print_fields row_fields
-        print_present tags
-  | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
-      fprintf ppf "@[<1>(%a)@]" print_out_type ty
-  | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
-
-and print_fields rest ppf = function
-  | [] ->
-      begin match rest with
-      | Some non_gen -> fprintf ppf "%s.." (if non_gen then "_" else "")
-      | None -> ()
-      end
-  | [(s, t)] ->
-      fprintf ppf "%s : %a" s print_out_type t;
-      begin match rest with
-      | Some _ -> fprintf ppf ";@ "
-      | None -> ()
-      end;
-      print_fields rest ppf []
-  | (s, t) :: l ->
-      fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields rest) l
-
-and print_row_field ppf (l, opt_amp, tyl) =
-  let pr_of ppf =
-    if opt_amp then fprintf ppf " of@ &@ "
-    else if tyl <> [] then fprintf ppf " of@ "
-    else fprintf ppf ""
-  in
-  fprintf ppf "@[<hv 2>`%s%t%a@]" l pr_of
-    (print_typlist print_out_type " &") tyl
-
-and print_typlist print_elem sep ppf = function
-  | [] -> ()
-  | [ty] -> print_elem ppf ty
-  | ty :: tyl ->
-      fprintf ppf "%a%s@ %a"
-        print_elem ty sep (print_typlist print_elem sep) tyl
-
-and print_typargs ppf =
-  function
-  | [] -> ()
-  | [ty1] -> fprintf ppf "%a@ " print_simple_out_type ty1
-  | tyl -> fprintf ppf "@[<1>(%a)@]@ " (print_typlist print_out_type ",") tyl
-
-let outcome_type = ref print_out_type
-
 let typexp sch prio ppf ty =
-  !outcome_type ppf (tree_of_typexp sch ty)
+  !Oprint.out_type ppf (tree_of_typexp sch ty)
 
 let type_expr ppf ty = typexp false 0 ppf ty
 
@@ -490,181 +368,6 @@ let type_scheme_max ?(b_reset_names=true) ppf ty =
 
 let tree_of_type_scheme ty = reset_and_mark_loops ty; tree_of_typexp true ty
 
-(* Print modules types and signatures *)
-
-let value_ident ppf name =
-  if List.mem name
-      ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"]
-  then fprintf ppf "( %s )" name
-  else match name.[0] with
-  | 'a' .. 'z' | '\223' .. '\246' | '\248' .. '\255' | '_' ->
-      fprintf ppf "%s" name
-  | _ -> fprintf ppf "( %s )" name
-
-let print_out_class_params ppf =
-  function
-  | [] -> ()
-  | tyl ->
-      fprintf ppf "@[<1>[%a]@]@ "
-        (print_list (fun ppf x -> fprintf ppf "'%s" x)
-           (fun ppf -> fprintf ppf ", "))
-        tyl
-
-let rec print_out_class_type ppf =
-  function
-  | Octy_constr (id, tyl) ->
-      let pr_tyl ppf = function
-        | [] -> ()
-        | tyl ->
-            fprintf ppf "@[<1>[%a]@]@ "
-              (print_typlist print_out_type ",") tyl
-      in
-      fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
-  | Octy_fun (lab, ty, cty) ->
-      fprintf ppf "@[%s%a ->@ %a@]"
-        (if lab <> "" then lab ^ ":" else "")
-        print_out_type_2 ty print_out_class_type cty
-  | Octy_signature (self_ty, csil) ->
-      let pr_param ppf =
-        function
-        | Some ty -> fprintf ppf "@ @[(%a)@]" print_out_type ty
-        | None -> ()
-      in
-      fprintf ppf "@[<hv 2>@[<2>object%a@]@ %a@;<1 -2>end@]"
-        pr_param self_ty
-        (print_list print_out_class_sig_item (fun ppf -> fprintf ppf "@ "))
-        csil
-and print_out_class_sig_item ppf =
-  function
-  | Ocsg_constraint (ty1, ty2) ->
-     fprintf ppf "@[<2>constraint %a =@ %a@]" !outcome_type ty1
-       !outcome_type ty2
-  | Ocsg_method (name, priv, virt, ty) ->
-     fprintf ppf "@[<2>method %s%s%s :@ %a@]"
-       (if priv then "private " else "") (if virt then "virtual " else "")
-       name !outcome_type ty
-  | Ocsg_value (name, mut, ty) ->
-     fprintf ppf "@[<2>val %s%s :@ %a@]" (if mut then "mutable " else "") name
-       !outcome_type ty
-
-let rec print_out_module_type ppf =
-  function
-  | Omty_abstract -> ()
-  | Omty_functor (name, mty_arg, mty_res) ->
-      fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
-        print_out_module_type mty_arg print_out_module_type mty_res
-  | Omty_ident id ->
-      fprintf ppf "%a" print_ident id
-  | Omty_signature sg ->
-      fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" print_signature_body sg
-and print_signature_body ppf =
-  function
-  | [] -> ()
-  | item :: [] -> print_out_sig_item ppf item
-  | item :: items ->
-      fprintf ppf "%a@ %a" print_out_sig_item item print_signature_body items
-and print_out_sig_item ppf =
-  function
-  | Osig_class (vir_flag, name, params, clt) ->
-      fprintf ppf "@[<2>class%s@ %a%s@ :@ %a@]"
-        (if vir_flag then " virtual" else "")
-        print_out_class_params params name print_out_class_type clt
-  | Osig_class_type (vir_flag, name, params, clt) ->
-      fprintf ppf "@[<2>class type%s@ %a%s@ =@ %a@]"
-        (if vir_flag then " virtual" else "")
-        print_out_class_params params name print_out_class_type clt
-  | Osig_exception (id, tyl) ->
-      fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl)
-  | Osig_modtype (name, Omty_abstract) ->
-      fprintf ppf "@[<2>module type %s@]" name
-  | Osig_modtype (name, mty) ->
-      fprintf ppf "@[<2>module type %s =@ %a@]" name print_out_module_type mty
-  | Osig_module (name, mty) ->
-      fprintf ppf "@[<2>module %s :@ %a@]" name print_out_module_type mty
-  | Osig_type tdl ->
-      print_out_type_decl_list ppf tdl
-  | Osig_value (name, ty, prims) ->
-      let kwd = if prims = [] then "val" else "external" in
-      let pr_prims ppf =
-        function
-        | [] -> ()
-        | s :: sl ->
-            fprintf ppf "@ = \"%s\"" s;
-            List.iter (fun s -> fprintf ppf "@ \"%s\"" s) sl
-      in
-      fprintf ppf "@[<2>%s %a :@ %a%a@]"
-        kwd value_ident name !outcome_type ty pr_prims prims
-and print_out_type_decl_list ppf =
-  function
-  | [] -> ()
-  | [x] -> print_out_type_decl "type" ppf x
-  | x :: l ->
-      print_out_type_decl "type" ppf x;
-      List.iter (fun x -> fprintf ppf "@ %a" (print_out_type_decl "and") x) l
-and print_out_type_decl kwd ppf (name, args, ty, constraints) =
-  let print_constraints ppf params =
-    List.iter
-      (fun (ty1, ty2) ->
-         fprintf ppf "@ @[<2>constraint %a =@ %a@]" !outcome_type ty1
-           !outcome_type ty2)
-      params
-  in
-  let type_parameter ppf (ty,(co,cn)) =
-    fprintf ppf "%s'%s"
-      (if not cn then "+" else if not co then "-" else "") ty
-  in
-  let type_defined ppf =
-    match args with
-    | [] -> fprintf ppf "%s" name
-    | [arg] -> fprintf ppf "@[%a@ %s@]" type_parameter arg name
-    | _ ->
-        fprintf ppf "@[(@[%a)@]@ %s@]"
-          (print_list type_parameter (fun ppf -> fprintf ppf ",@ "))
-          args name
-  in
-  let print_manifest ppf =
-    function
-    | Otyp_manifest (ty, _) -> fprintf ppf " =@ %a" !outcome_type ty
-    | _ -> ()
-  in
-  let print_name_args ppf =
-    fprintf ppf "%s %t%a" kwd type_defined print_manifest ty
-  in
-  let ty =
-    match ty with
-    | Otyp_manifest (_, ty) -> ty
-    | _ -> ty
-  in
-  match ty with
-  | Otyp_abstract ->
-      fprintf ppf "@[<2>@[<hv 2>%t@]%a@]"
-        print_name_args print_constraints constraints
-  | Otyp_record lbls ->
-      fprintf ppf "@[<2>@[<hv 2>%t = {%a@;<1 -2>}@]@ %a@]"
-        print_name_args
-        (print_list_init print_out_label (fun ppf -> fprintf ppf "@ ")) lbls
-        print_constraints constraints
-  | Otyp_sum constrs ->
-      fprintf ppf "@[<2>@[<hv 2>%t =@;<1 2>%a@]%a@]"
-        print_name_args
-        (print_list print_out_constr (fun ppf -> fprintf ppf "@ | ")) constrs
-        print_constraints constraints
-  | ty ->
-      fprintf ppf "@[<2>@[<hv 2>%t =@ %a@]%a@]"
-        print_name_args !outcome_type ty
-        print_constraints constraints
-and print_out_constr ppf (name, tyl) =
-  match tyl with
-  | [] -> fprintf ppf "%s" name
-  | _ ->
-      fprintf ppf "@[<2>%s of@ %a@]" name
-        (print_typlist print_simple_out_type " *") tyl
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%s :@ %a@];"
-    (if mut then "mutable " else "") name !outcome_type arg
-
-let outcome_sig_item = ref print_out_sig_item
-
 (* Print one type declaration *)
 
 let constrain ppf ty =
@@ -771,7 +474,7 @@ let tree_of_type_declaration id decl =
   Osig_type [tree_of_type_decl id decl]
 
 let type_declaration id ppf decl =
-  !outcome_sig_item ppf (tree_of_type_declaration id decl)
+  !Oprint.out_sig_item ppf (tree_of_type_declaration id decl)
 
 (* Print an exception declaration *)
 
@@ -780,7 +483,7 @@ let tree_of_exception_declaration id decl =
   Osig_exception (Ident.name id, tyl)
 
 let exception_declaration id ppf decl =
-  !outcome_sig_item ppf (tree_of_exception_declaration id decl)
+  !Oprint.out_sig_item ppf (tree_of_exception_declaration id decl)
 
 (* Print a value declaration *)
 
@@ -795,7 +498,7 @@ let tree_of_value_description id decl =
   Osig_value (id, ty, prims)
 
 let value_description id ppf decl =
-  !outcome_sig_item ppf (tree_of_value_description id decl)
+  !Oprint.out_sig_item ppf (tree_of_value_description id decl)
 
 (* Print a class type *)
 
@@ -903,7 +606,7 @@ let rec tree_of_class_type sch params =
 let class_type ppf cty =
   reset ();
   prepare_class_type [] cty;
-  print_out_class_type ppf (tree_of_class_type false [] cty)
+  !Oprint.out_class_type ppf (tree_of_class_type false [] cty)
 
 let tree_of_class_params = function
   | [] -> []
@@ -929,7 +632,7 @@ let tree_of_class_declaration id cl =
      tree_of_class_type true params cl.cty_type)
 
 let class_declaration id ppf cl =
-  !outcome_sig_item ppf (tree_of_class_declaration id cl)
+  !Oprint.out_sig_item ppf (tree_of_class_declaration id cl)
 
 let tree_of_cltype_declaration id cl =
   let params = List.map repr cl.clty_params in
@@ -958,7 +661,7 @@ let tree_of_cltype_declaration id cl =
      tree_of_class_type true params cl.clty_type)
 
 let cltype_declaration id ppf cl =
-  !outcome_sig_item ppf (tree_of_cltype_declaration id cl)
+  !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl)
 
 (* Print a module type *)
 
@@ -1026,18 +729,17 @@ and tree_of_modtype_declaration id decl =
 
 let tree_of_module id mty = Osig_module (Ident.name id, tree_of_modtype mty)
 
-let modtype ppf mty = print_out_module_type ppf (tree_of_modtype mty)
+let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
 let modtype_declaration id ppf decl =
-  !outcome_sig_item ppf (tree_of_modtype_declaration id decl)
+  !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
 
 (* Print a signature body (used by -i when compiling a .ml) *)
 
 let print_signature ppf tree =
-  fprintf ppf "@[<v>%a@]" print_signature_body tree
-let outcome_signature = ref print_signature
+  fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
 
 let signature ppf sg =
-  fprintf ppf "%a" !outcome_signature (tree_of_signature sg)
+  fprintf ppf "%a" print_signature (tree_of_signature sg)
 
 (* Print an unification error *)
 
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index ca08cba457..45d8762282 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -64,7 +64,3 @@ val report_unification_error:
 val report_subtyping_error:
     formatter -> (type_expr * type_expr) list ->
     string -> (type_expr * type_expr) list -> unit
-
-val outcome_type: (formatter -> out_type -> unit) ref
-val outcome_sig_item: (formatter -> out_sig_item -> unit) ref
-val outcome_signature: (formatter -> out_sig_item list -> unit) ref
diff --git a/utils/ccomp.ml b/utils/ccomp.ml
index 9cbf9501c8..8571379870 100644
--- a/utils/ccomp.ml
+++ b/utils/ccomp.ml
@@ -24,17 +24,16 @@ let command cmdline =
 
 let run_command cmdline = ignore(command cmdline)
 
-let quote = Filename.quote;;
-
 let compile_file name =
   match Sys.os_type with
   | "MacOS" ->
-     let qname = quote name in
-     let includes = Config.standard_library :: !Clflags.include_dirs in
+     let qname = Filename.quote name in
+     let includes = (Clflags.std_include_dir ()) @ !Clflags.include_dirs
+     in
      let args =
        Printf.sprintf " %s %s -i %s"
-         (String.concat " " (List.rev_map quote !Clflags.ccopts))
-         (String.concat "," (List.rev_map quote includes))
+         (String.concat " " (List.rev_map Filename.quote !Clflags.ccopts))
+         (String.concat "," (List.rev_map Filename.quote includes))
          qname
      in
      run_command ("sc " ^ args ^ " -o " ^ qname ^ ".o");
@@ -42,12 +41,12 @@ let compile_file name =
   | _ ->
      command
        (Printf.sprintf
-         "%s -c %s %s -I%s %s"
+         "%s -c %s %s %s %s"
          !Clflags.c_compiler
          (String.concat " " (List.rev !Clflags.ccopts))
          (String.concat " "
            (List.rev_map (fun dir -> "-I" ^ dir) !Clflags.include_dirs))
-         Config.standard_library
+         (Clflags.std_include_flag "-I")
          name)
 ;;
 
diff --git a/utils/clflags.ml b/utils/clflags.ml
index 1bcbbec884..295e2837ae 100644
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -23,6 +23,7 @@ and exec_name = ref "a.out"             (* -o *)
 and archive_name = ref "library.cma"    (* -o *)
 and object_name = ref ("camlprog" ^ Config.ext_obj) (* -o *)
 and include_dirs = ref ([] : string list)(* -I *)
+and no_std_include = ref false          (* -nostdlib *)
 and print_types = ref false             (* -i *)
 and make_archive = ref false            (* -a *)
 and debug = ref false                   (* -g *)
@@ -37,10 +38,10 @@ and preprocessor = ref(None : string option) (* -pp *)
 and thread_safe = ref false             (* -thread *)
 and noassert = ref false                (* -noassert *)
 and verbose = ref false                 (* -verbose *)
-and use_prims = ref ""                  (* -use_prims ... *)
-and use_runtime = ref ""                (* -use_runtime ... *)
-and recursive_types = ref false         (* -rectypes *)
+and use_prims = ref ""                  (* -use-prims ... *)
+and use_runtime = ref ""                (* -use-runtime ... *)
 and principal = ref false               (* -principal *)
+and recursive_types = ref false         (* -rectypes *)
 and make_runtime = ref false            (* -make_runtime *)
 and gprofile = ref false                (* -p *)
 and c_compiler = ref Config.bytecomp_c_compiler (* -cc *)
@@ -75,3 +76,12 @@ let native_code = ref false             (* set to true under ocamlopt *)
 
 let inline_threshold = ref 10
 
+
+let std_include_flag prefix =
+  if !no_std_include then ""
+  else (prefix ^ (Filename.quote Config.standard_library))
+;;
+
+let std_include_dir () =
+  if !no_std_include then [] else [Config.standard_library]
+;;