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
open Import
let print_loc buf (_, _) =
bprintf buf "loc"
let print_list f buf l =
bprintf buf "[";
List.iter (fun x -> bprintf buf "%a;\n" f x) l;
bprintf buf "]"
let print_opt f buf o =
match o with
None -> bprintf buf "None"
| Some x -> bprintf buf "Some (%a)" f x
let print_qstring buf s = bprintf buf "%S" s
let print_prop_list buf l =
print_list (
fun buf (s, (loc, o)) ->
bprintf buf "(%S, (%a, %a))"
s print_loc loc (print_opt print_qstring) o
)
buf l
let print_annot_list buf l =
print_list (
fun buf (s, (loc, l)) ->
bprintf buf "(%S, (%a, %a))" s print_loc loc print_prop_list l
)
buf l
let rec print_type_expr buf (x : Ast.type_expr) =
match x with
| Sum (loc, variant_list, annot_list) ->
bprintf buf "`Sum (%a, %a, %a)"
print_loc loc
(print_list print_variant) variant_list
print_annot_list annot_list
| Record (loc, field_list, annot_list) ->
bprintf buf "`Record (%a, %a, %a)"
print_loc loc
(print_list print_field) field_list
print_annot_list annot_list
| Tuple (loc, cell_list, annot_list) ->
bprintf buf "`Tuple (%a, %a, %a)"
print_loc loc
(print_list print_cell) cell_list
print_annot_list annot_list
| List (loc, type_expr, annot_list) ->
bprintf buf "`List (%a, %a, %a)"
print_loc loc
print_type_expr type_expr
print_annot_list annot_list
| Option (loc, type_expr, annot_list) ->
bprintf buf "`Option (%a, %a, %a)"
print_loc loc
print_type_expr type_expr
print_annot_list annot_list
| Nullable (loc, type_expr, annot_list) ->
bprintf buf "`Nullable (%a, %a, %a)"
print_loc loc
print_type_expr type_expr
print_annot_list annot_list
| Shared (loc, type_expr, annot_list) ->
bprintf buf "`Shared (%a, %a, %a)"
print_loc loc
print_type_expr type_expr
print_annot_list annot_list
| Wrap (loc, type_expr, annot_list) ->
bprintf buf "`Wrap (%a, %a, %a)"
print_loc loc
print_type_expr type_expr
print_annot_list annot_list
| Name (loc, type_inst, annot_list) ->
bprintf buf "`Name (%a, %a, %a)"
print_loc loc
print_type_inst type_inst
print_annot_list annot_list
| Tvar (loc, string) ->
bprintf buf "`Tvar (%a, %S)"
print_loc loc
string
and print_cell buf (loc, x, a) =
bprintf buf "(%a, %a, %a)"
print_loc loc
print_type_expr x
print_annot_list a
and print_variant buf x =
match x with
Variant (loc, (s, a), o) ->
bprintf buf "`Variant (%a, (%S, %a), %a)"
print_loc loc
s print_annot_list a
(print_opt print_type_expr) o
| Inherit (loc, x) ->
bprintf buf "`Inherit (%a, %a)"
print_loc loc
print_type_expr x
and print_field buf x =
match x with
`Field (loc, (s, kind, a), x) ->
bprintf buf "`Field (%a, (%S, %a, %a), %a)"
print_loc loc
s print_field_kind kind print_annot_list a
print_type_expr x
| `Inherit (loc, x) ->
bprintf buf "`Inherit (%a, %a)"
print_loc loc
print_type_expr x
and print_field_kind buf fk =
Buffer.add_string buf
(match fk with
Required -> "`Required"
| Optional -> "`Optional"
| With_default -> "`With_default")
and print_type_inst buf (loc, s, l) =
bprintf buf "(%a, %S, %a)"
print_loc loc
s
(print_list print_type_expr) l
let print_module_item buf (Ast.Type (loc, (name, param, a), x)) =
bprintf buf "`Type (%a, (%S, %a, %a), %a)"
print_loc loc
name (print_list print_qstring) param print_annot_list a
print_type_expr x
let print_module_body buf l =
bprintf buf "[\n";
List.iter (fun x ->
print_module_item buf x;
bprintf buf ";\n"
) l;
bprintf buf "]\n"
let print_module_body_def buf name l =
bprintf buf "\
let %s_body : Ast.module_body =
let loc = Ast.dummy_loc in
%a
let %s = %s_body (* for backward compatibility with atd <= 1.0.1 *)
"
name print_module_body l
name name
let print_module_head_def buf name an =
bprintf buf "\
let %s_head : Ast.module_head =
let loc = Ast.dummy_loc in
(loc, %a)
"
name print_annot_list an
let print_full_module_def buf name ((_, an), l) =
print_module_head_def buf name an;
print_module_body_def buf name l;
bprintf buf "\
let %s_full : Ast.full_module =
(%s_head, %s_body)
"
name name name