Regroupement des impressions "outcometree" dans un seul module oprint.ml.

Ajout de hooks de print dans toploop.mli.


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

12 files changed, 478 insertions, 443 deletions

diff --git a/.depend b/.depend
index 6e888a194..fbfd7c01f 100644
--- a/.depend
+++ b/.depend
@@ -137,6 +137,8 @@ typing/mtype.cmo: typing/btype.cmi typing/ctype.cmi typing/env.cmi \
     typing/ident.cmi typing/path.cmi typing/types.cmi typing/mtype.cmi 
 typing/mtype.cmx: typing/btype.cmx typing/ctype.cmx typing/env.cmx \
     typing/ident.cmx typing/path.cmx typing/types.cmx typing/mtype.cmi 
+typing/oprint.cmo: typing/outcometree.cmi 
+typing/oprint.cmx: typing/outcometree.cmi 
 typing/parmatch.cmo: parsing/asttypes.cmi typing/btype.cmi typing/ctype.cmi \
     typing/datarepr.cmi typing/env.cmi typing/ident.cmi parsing/location.cmi \
     utils/misc.cmi typing/path.cmi typing/typedtree.cmi typing/types.cmi \
@@ -155,12 +157,14 @@ typing/primitive.cmo: utils/misc.cmi typing/primitive.cmi
 typing/primitive.cmx: utils/misc.cmx typing/primitive.cmi 
 typing/printtyp.cmo: parsing/asttypes.cmi typing/btype.cmi utils/clflags.cmo \
     typing/ctype.cmi typing/env.cmi typing/ident.cmi parsing/longident.cmi \
-    utils/misc.cmi typing/outcometree.cmi typing/path.cmi typing/predef.cmi \
-    typing/primitive.cmi typing/types.cmi typing/printtyp.cmi 
+    utils/misc.cmi typing/oprint.cmo typing/outcometree.cmi typing/path.cmi \
+    typing/predef.cmi typing/primitive.cmi typing/types.cmi \
+    typing/printtyp.cmi 
 typing/printtyp.cmx: parsing/asttypes.cmi typing/btype.cmx utils/clflags.cmx \
     typing/ctype.cmx typing/env.cmx typing/ident.cmx parsing/longident.cmx \
-    utils/misc.cmx typing/outcometree.cmi typing/path.cmx typing/predef.cmx \
-    typing/primitive.cmx typing/types.cmx typing/printtyp.cmi 
+    utils/misc.cmx typing/oprint.cmx typing/outcometree.cmi typing/path.cmx \
+    typing/predef.cmx typing/primitive.cmx typing/types.cmx \
+    typing/printtyp.cmi 
 typing/subst.cmo: typing/btype.cmi typing/ident.cmi utils/misc.cmi \
     typing/path.cmi utils/tbl.cmi typing/types.cmi typing/subst.cmi 
 typing/subst.cmx: typing/btype.cmx typing/ident.cmx utils/misc.cmx \
@@ -702,7 +706,7 @@ toplevel/toploop.cmo: bytecomp/bytegen.cmi utils/clflags.cmo \
     bytecomp/emitcode.cmi typing/env.cmi driver/errors.cmi \
     toplevel/genprintval.cmi typing/ident.cmi parsing/lexer.cmi \
     parsing/location.cmi parsing/longident.cmi bytecomp/meta.cmi \
-    utils/misc.cmi typing/outcometree.cmi parsing/parse.cmi \
+    utils/misc.cmi typing/oprint.cmo typing/outcometree.cmi parsing/parse.cmi \
     parsing/parsetree.cmi typing/path.cmi typing/predef.cmi \
     parsing/printast.cmi bytecomp/printinstr.cmi bytecomp/printlambda.cmi \
     typing/printtyp.cmi bytecomp/simplif.cmi bytecomp/symtable.cmi \
@@ -713,7 +717,7 @@ toplevel/toploop.cmx: bytecomp/bytegen.cmx utils/clflags.cmx \
     bytecomp/emitcode.cmx typing/env.cmx driver/errors.cmx \
     toplevel/genprintval.cmx typing/ident.cmx parsing/lexer.cmx \
     parsing/location.cmx parsing/longident.cmx bytecomp/meta.cmx \
-    utils/misc.cmx typing/outcometree.cmi parsing/parse.cmx \
+    utils/misc.cmx typing/oprint.cmx typing/outcometree.cmi parsing/parse.cmx \
     parsing/parsetree.cmi typing/path.cmx typing/predef.cmx \
     parsing/printast.cmx bytecomp/printinstr.cmx bytecomp/printlambda.cmx \
     typing/printtyp.cmx bytecomp/simplif.cmx bytecomp/symtable.cmx \
diff --git a/Makefile b/Makefile
index 97d66a41a..99632799a 100644
--- a/Makefile
+++ b/Makefile
@@ -42,7 +42,7 @@ PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \
 
 TYPING=typing/ident.cmo typing/path.cmo \
   typing/primitive.cmo typing/types.cmo \
-  typing/btype.cmo \
+  typing/btype.cmo typing/oprint.cmo \
   typing/subst.cmo typing/predef.cmo \
   typing/datarepr.cmo typing/env.cmo \
   typing/typedtree.cmo typing/ctype.cmo \
diff --git a/debugger/.depend b/debugger/.depend
index 4931c88c3..6156f86af 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -125,13 +125,13 @@ pattern_matching.cmx: ../typing/ctype.cmx debugcom.cmx debugger_config.cmx \
 primitives.cmo: ../otherlibs/unix/unix.cmi primitives.cmi 
 primitives.cmx: ../otherlibs/unix/unix.cmx primitives.cmi 
 printval.cmo: debugcom.cmi ../toplevel/genprintval.cmi ../utils/misc.cmi \
-    ../typing/outcometree.cmi parser_aux.cmi ../typing/path.cmi \
-    ../typing/printtyp.cmi ../bytecomp/symtable.cmi ../typing/types.cmi \
-    printval.cmi 
+    ../typing/oprint.cmo ../typing/outcometree.cmi parser_aux.cmi \
+    ../typing/path.cmi ../typing/printtyp.cmi ../bytecomp/symtable.cmi \
+    ../typing/types.cmi printval.cmi 
 printval.cmx: debugcom.cmx ../toplevel/genprintval.cmx ../utils/misc.cmx \
-    ../typing/outcometree.cmi parser_aux.cmi ../typing/path.cmx \
-    ../typing/printtyp.cmx ../bytecomp/symtable.cmx ../typing/types.cmx \
-    printval.cmi 
+    ../typing/oprint.cmx ../typing/outcometree.cmi parser_aux.cmi \
+    ../typing/path.cmx ../typing/printtyp.cmx ../bytecomp/symtable.cmx \
+    ../typing/types.cmx printval.cmi 
 program_loading.cmo: debugger_config.cmi input_handling.cmi ../utils/misc.cmi \
     parameters.cmi primitives.cmi ../otherlibs/unix/unix.cmi unix_tools.cmi \
     program_loading.cmi 
diff --git a/debugger/Makefile b/debugger/Makefile
index 562d758f9..eb724082b 100644
--- a/debugger/Makefile
+++ b/debugger/Makefile
@@ -35,7 +35,7 @@ OTHEROBJS=\
   ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
   ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
   ../typing/subst.cmo ../typing/predef.cmo \
-  ../typing/datarepr.cmo ../typing/env.cmo \
+  ../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \
   ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
   ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
   ../bytecomp/dll.cmo ../bytecomp/symtable.cmo \
diff --git a/debugger/printval.ml b/debugger/printval.ml
index a67ca337c..4fa3055b0 100644
--- a/debugger/printval.ml
+++ b/debugger/printval.ml
@@ -86,13 +86,13 @@ let max_printer_steps = ref 300
 
 let print_exception ppf obj =
   let t = Printer.outval_of_untyped_exception obj in
-  Printer.print_outval ppf t
+  !Oprint.out_value ppf t
 
 let print_value max_depth env obj (ppf : Format.formatter) ty =
   let t =
     Printer.outval_of_value !max_printer_steps max_depth
       (check_depth ppf) env obj ty in
-  Printer.print_outval ppf t
+  !Oprint.out_value ppf t
 
 let print_named_value max_depth exp env obj ppf ty =
   let print_value_name ppf = function
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index 5b19fb8d8..788c69db4 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
@@ -354,78 +353,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 76b091e78..898588b2d 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 5fc8bb1bb..272caeecc 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 39b4784ee..4c3ca35d4 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/typing/oprint.ml b/typing/oprint.ml
new file mode 100644
index 000000000..f04cc95d5
--- /dev/null
+++ b/typing/oprint.ml
@@ -0,0 +1,425 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*                  Projet Cristal, INRIA Rocquencourt                 *)
+(*                                                                     *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+open Format
+open Outcometree
+
+exception Ellipsis
+
+let cautious f ppf arg = try f ppf arg with Ellipsis -> fprintf ppf "..."
+
+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 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
+
+(* Values *)
+
+let print_out_value ppf tree =
+  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
+
+(* Types *)
+
+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 pr_present =
+  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
+
+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_present 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_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
+
+(* Class types *)
+
+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@]" print_out_type ty1
+       print_out_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 print_out_type ty
+  | Ocsg_value (name, mut, ty) ->
+     fprintf ppf "@[<2>val %s%s :@ %a@]" (if mut then "mutable " else "") name
+       print_out_type ty
+
+(* Signature *)
+
+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_out_signature sg
+and print_out_signature ppf =
+  function
+  | [] -> ()
+  | item :: [] -> print_out_sig_item ppf item
+  | item :: items ->
+      fprintf ppf "%a@ %a" print_out_sig_item item print_out_signature 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 print_out_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@]" print_out_type ty1
+           print_out_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" print_out_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 print_out_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 print_out_type arg
+
+(* Phrases *)
+
+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
+
+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;;
+
+let print_out_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
+
+(* Hooks *)
+
+let out_value = ref print_out_value
+let out_type = ref print_out_type
+let out_class_type = ref print_out_class_type
+let out_module_type = ref print_out_module_type
+let out_sig_item = ref print_out_sig_item
+let out_signature = ref print_out_signature
+let out_phrase = ref print_out_phrase
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 96a847859..8b28c49da 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -173,15 +173,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
@@ -317,118 +308,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_present =
-  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
-
-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_present 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_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
 
@@ -444,181 +325,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 =
@@ -725,7 +431,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 *)
 
@@ -734,7 +440,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 *)
 
@@ -749,7 +455,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 *)
 
@@ -856,7 +562,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
   | [] -> []
@@ -882,7 +588,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
@@ -911,7 +617,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 *)
 
@@ -979,18 +685,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 ca08cba45..45d876228 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