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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
(***********************************************************************)
(* 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. *)
(* *)
(***********************************************************************)
(** The functions to get a string from different kinds of elements (types, modules, ...). *)
module Name = Odoc_name
let string_of_variance t (co,cn) =
if t.Odoc_type.ty_kind = Odoc_type.Type_abstract &&
t.Odoc_type.ty_manifest = None
then
match (co, cn) with
(true, false) -> "+"
| (false, true) -> "-"
| _ -> ""
else
""
let raw_string_of_type_list sep type_list =
let rec need_parent t =
match t.Types.desc with
Types.Tarrow _ | Types.Ttuple _ -> true
| Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
| Types.Tconstr _ ->
false
| Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
| Types.Tfield _ | Types.Tnil | Types.Tvariant _ -> false
in
let print_one_type variance t =
Printtyp.mark_loops t;
if need_parent t then
(
Format.fprintf Format.str_formatter "(%s" variance;
Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t;
Format.fprintf Format.str_formatter ")"
)
else
(
Format.fprintf Format.str_formatter "%s" variance;
Printtyp.type_scheme_max ~b_reset_names: false Format.str_formatter t
)
in
begin match type_list with
[] -> ()
| [(variance, ty)] -> print_one_type variance ty
| (variance, ty) :: tyl ->
Format.fprintf Format.str_formatter "@[<hov 2>(";
print_one_type variance ty;
List.iter
(fun (variance, t) ->
Format.fprintf Format.str_formatter "@,%s" sep;
print_one_type variance t
)
tyl;
Format.fprintf Format.str_formatter ")@]"
end;
Format.flush_str_formatter()
let string_of_type_list sep type_list =
raw_string_of_type_list sep (List.map (fun t -> ("", t)) type_list)
let string_of_type_param_list t =
raw_string_of_type_list ", "
(List.map
(fun (typ, co, cn) -> (string_of_variance t (co, cn), typ))
t.Odoc_type.ty_parameters
)
let string_of_type t =
let module M = Odoc_type in
"type "^
(String.concat ""
(List.map
(fun (p, co, cn) ->
(string_of_variance t (co, cn))^
(Odoc_misc.string_of_type_expr p)^" "
)
t.M.ty_parameters
)
)^
(Name.simple t.M.ty_name)^" "^
(match t.M.ty_manifest with
None -> ""
| Some typ -> "= "^(Odoc_misc.string_of_type_expr typ)^" "
)^
(match t.M.ty_kind with
M.Type_abstract ->
""
| M.Type_variant (l, priv) ->
"="^(if priv then " private" else "")^"\n"^
(String.concat ""
(List.map
(fun cons ->
" | "^cons.M.vc_name^
(match cons.M.vc_args with
[] -> ""
| l ->
" of "^(String.concat " * "
(List.map (fun t -> "("^(Odoc_misc.string_of_type_expr t)^")") l))
)^
(match cons.M.vc_text with
None ->
""
| Some t ->
"(* "^(Odoc_misc.string_of_text t)^" *)"
)^"\n"
)
l
)
)
| M.Type_record (l, priv) ->
"= "^(if priv then "private " else "")^"{\n"^
(String.concat ""
(List.map
(fun record ->
" "^(if record.M.rf_mutable then "mutable " else "")^
record.M.rf_name^" : "^(Odoc_misc.string_of_type_expr record.M.rf_type)^";"^
(match record.M.rf_text with
None ->
""
| Some t ->
"(* "^(Odoc_misc.string_of_text t)^" *)"
)^"\n"
)
l
)
)^
"}\n"
)^
(match t.M.ty_info with
None -> ""
| Some info -> Odoc_misc.string_of_info info)
let string_of_exception e =
let module M = Odoc_exception in
"exception "^(Name.simple e.M.ex_name)^
(match e.M.ex_args with
[] -> ""
| _ ->" : "^
(String.concat " -> "
(List.map (fun t -> "("^(Odoc_misc.string_of_type_expr t)^")") e.M.ex_args)
)
)^
(match e.M.ex_alias with
None -> ""
| Some ea ->
" = "^
(match ea.M.ea_ex with
None -> ea.M.ea_name
| Some e2 -> e2.M.ex_name
)
)^"\n"^
(match e.M.ex_info with
None -> ""
| Some i -> Odoc_misc.string_of_info i)
let string_of_value v =
let module M = Odoc_value in
"val "^(Name.simple v.M.val_name)^" : "^
(Odoc_misc.string_of_type_expr v.M.val_type)^"\n"^
(match v.M.val_info with
None -> ""
| Some i -> Odoc_misc.string_of_info i)
let string_of_attribute a =
let module M = Odoc_value in
"val "^
(if a.M.att_mutable then Odoc_messages.mutab^" " else "")^
(Name.simple a.M.att_value.M.val_name)^" : "^
(Odoc_misc.string_of_type_expr a.M.att_value.M.val_type)^"\n"^
(match a.M.att_value.M.val_info with
None -> ""
| Some i -> Odoc_misc.string_of_info i)
let string_of_method m =
let module M = Odoc_value in
"method "^
(if m.M.met_private then Odoc_messages.privat^" " else "")^
(Name.simple m.M.met_value.M.val_name)^" : "^
(Odoc_misc.string_of_type_expr m.M.met_value.M.val_type)^"\n"^
(match m.M.met_value.M.val_info with
None -> ""
| Some i -> Odoc_misc.string_of_info i)
|
