1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
(***********************************************************************)
(* *)
(* OCamldoc *)
(* *)
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 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. *)
(* *)
(***********************************************************************)
open Format
let new_fmt () =
let buf = Buffer.create 512 in
let fmt = formatter_of_buffer buf in
let flush () =
pp_print_flush fmt ();
let s = Buffer.contents buf in
Buffer.reset buf ;
s
in
(fmt, flush)
let (type_fmt, flush_type_fmt) = new_fmt ()
let _ =
let (out, flush, outnewline, outspace) =
pp_get_all_formatter_output_functions type_fmt ()
in
pp_set_all_formatter_output_functions type_fmt
~out ~flush
~newline: (fun () -> out "\n " 0 3)
~spaces: outspace
let (modtype_fmt, flush_modtype_fmt) = new_fmt ()
let string_of_type_expr t =
Printtyp.mark_loops t;
Printtyp.type_scheme_max ~b_reset_names: false type_fmt t;
flush_type_fmt ()
exception Use_code of string
(** Return the given module type where methods and vals have been removed
from the signatures. Used when we don't want to print a too long module type.
@param code when the code is given, we raise the [Use_code] exception is we
encouter a signature, to that the calling function can use the code rather
than the "emptied" type.
*)
let simpl_module_type ?code t =
let rec iter t =
match t with
Types.Mty_ident p -> t
| Types.Mty_signature _ ->
(
match code with
None -> Types.Mty_signature []
| Some s -> raise (Use_code s)
)
| Types.Mty_functor (id, mt1, mt2) ->
Types.Mty_functor (id, iter mt1, iter mt2)
in
iter t
let string_of_module_type ?code ?(complete=false) t =
try
let t2 = if complete then t else simpl_module_type ?code t in
Printtyp.modtype modtype_fmt t2;
flush_modtype_fmt ()
with
Use_code s -> s
(** Return the given class type where methods and vals have been removed
from the signatures. Used when we don't want to print a too long class type.*)
let simpl_class_type t =
let rec iter t =
match t with
Types.Cty_constr (p,texp_list,ct) -> t
| Types.Cty_signature cs ->
(* on vire les vals et methods pour ne pas qu'elles soient imprimees
quand on affichera le type *)
let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in
Types.Cty_signature { Types.cty_self = { cs.Types.cty_self with
Types.desc = Types.Tobject (tnil, ref None) };
Types.cty_vars = Types.Vars.empty ;
Types.cty_concr = Types.Concr.empty ;
Types.cty_inher = []
}
| Types.Cty_fun (l, texp, ct) ->
let new_ct = iter ct in
Types.Cty_fun (l, texp, new_ct)
in
iter t
let string_of_class_type ?(complete=false) t =
let t2 = if complete then t else simpl_class_type t in
(* A VOIR : ma propre version de Printtyp.class_type pour ne pas faire reset_names *)
Printtyp.class_type modtype_fmt t2;
flush_modtype_fmt ()
|
