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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
(* TEST
* expect *)
type 'a tree =
| Leaf of 'a
| Node of 'a tree * 'a tree
[%%expect{|
type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
|}]
module Ambiguous = struct
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (left, right) ->
Node (map f left, map f right)
end
[%%expect{|
Line 5, characters 4-34:
5 | Node (map f left, map f right)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
in several different ways. Please disambiguate by adding an explicit
[@tailcall] attribute to the call that should be made tail-recursive,
or a [@tailcall false] attribute on calls that should not be
transformed.
Line 5, characters 10-20:
5 | Node (map f left, map f right)
^^^^^^^^^^
This call could be annotated.
Line 5, characters 22-33:
5 | Node (map f left, map f right)
^^^^^^^^^^^
This call could be annotated.
|}]
module Positive_disambiguation = struct
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (left, right) ->
Node (map f left, (map [@tailcall]) f right)
end
[%%expect{|
module Positive_disambiguation :
sig val map : ('a -> 'b) -> 'a tree -> 'b tree end
|}]
module Negative_disambiguation = struct
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (left, right) ->
Node ((map [@tailcall false]) f left, map f right)
end
[%%expect{|
module Negative_disambiguation :
sig val map : ('a -> 'b) -> 'a tree -> 'b tree end
|}]
module Positive_and_negative_disambiguation = struct
(* in-depth disambiguations *)
type 'a t =
| N
| C of 'a t * ('a t * 'a t)
let[@tail_mod_cons] rec map1 f l =
match l with
| N -> N
| C (a, (b, c)) ->
C ((map1 [@tailcall]) f a, ((map1 [@tailcall false]) f b, map1 f c))
let[@tail_mod_cons] rec map2 f l =
match l with
| N -> N
| C (a, (b, c)) ->
C ((map2 [@tailcall false]) f a, ((map2 [@tailcall]) f b, map2 f c))
end
[%%expect {|
module Positive_and_negative_disambiguation :
sig
type 'a t = N | C of 'a t * ('a t * 'a t)
val map1 : 'a -> 'b t -> 'c t
val map2 : 'a -> 'b t -> 'c t
end
|}]
module Long_before_and_after = struct
type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree * 'a tree * 'a tree * 'a tree
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (t1, t2, t3, t4, t5) ->
(* manual unfolding *)
Node (map f t1, map f t2, (map[@tailcall]) f t3, map f t4, map f t5)
let () =
assert (map succ (Node (Leaf 0, Leaf 1, Leaf 2, Leaf 3, Leaf 4))
= Node (Leaf 1, Leaf 2, Leaf 3, Leaf 4, Leaf 5))
end
[%%expect {|
module Long_before_and_after :
sig
type 'a tree =
Leaf of 'a
| Node of 'a tree * 'a tree * 'a tree * 'a tree * 'a tree
val map : ('a -> 'b) -> 'a tree -> 'b tree
end
|}]
module Deep_nesting_nonambiguous = struct
type 'a tree = Leaf of 'a | Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (t1, (t2, (t3, (t4, t5)))) ->
Node (map f t1, (map f t2, ((map[@tailcall]) f t3, (map f t4, map f t5))))
let () =
assert (map succ (Node (Leaf 0, (Leaf 1, (Leaf 2, (Leaf 3, Leaf 4)))))
= Node (Leaf 1, (Leaf 2, (Leaf 3, (Leaf 4, Leaf 5)))))
end
[%%expect {|
module Deep_nesting_nonambiguous :
sig
type 'a tree =
Leaf of 'a
| Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
val map : ('a -> 'b) -> 'a tree -> 'b tree
end
|}]
module Deep_nesting_ambiguous = struct
type 'a tree = Leaf of 'a | Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
let[@tail_mod_cons] rec map f = function
| Leaf v -> Leaf (f v)
| Node (t1, (t2, (t3, (t4, t5)))) ->
Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
let () =
assert (map succ (Node (Leaf 0, (Leaf 1, (Leaf 2, (Leaf 3, Leaf 4)))))
= Node (Leaf 1, (Leaf 2, (Leaf 3, (Leaf 4, Leaf 5)))))
end
[%%expect {|
Line 7, characters 10-71:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
in several different ways. Please disambiguate by adding an explicit
[@tailcall] attribute to the call that should be made tail-recursive,
or a [@tailcall false] attribute on calls that should not be
transformed.
Line 7, characters 16-24:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^
This call could be annotated.
Line 7, characters 27-35:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^
This call could be annotated.
Line 7, characters 38-46:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^
This call could be annotated.
Line 7, characters 49-57:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^
This call could be annotated.
Line 7, characters 59-67:
7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
^^^^^^^^
This call could be annotated.
|}]
module Disjunctions_ambiguous = struct
type t = Leaf of int | Node of t * t
(** [shift ~flip:false k t] shifts all the leaves of [t] by [k].
When [~flip:true], leaves of even level are shifted by k,
leaves of odd level by (-k) *)
let[@tail_mod_cons] rec shift ~flip k = function
| Leaf n -> Leaf (n + k)
| Node (left, right) ->
(* This example contains several ambiguous TMC calls per constructor argument:
the two subcalls of each arguments are *both* in TMC position, and annotating
either of them is enough to fix the ambiguity error. *)
Node (
(if flip
then shift ~flip (- k) left
else shift ~flip k left),
(if flip
then shift ~flip (- k) right
else shift ~flip k right)
)
end
[%%expect {|
Lines 13-20, characters 8-9:
13 | ........Node (
14 | (if flip
15 | then shift ~flip (- k) left
16 | else shift ~flip k left),
17 | (if flip
18 | then shift ~flip (- k) right
19 | else shift ~flip k right)
20 | )
Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
in several different ways. Please disambiguate by adding an explicit
[@tailcall] attribute to the call that should be made tail-recursive,
or a [@tailcall false] attribute on calls that should not be
transformed.
Line 15, characters 16-38:
15 | then shift ~flip (- k) left
^^^^^^^^^^^^^^^^^^^^^^
This call could be annotated.
Line 16, characters 16-34:
16 | else shift ~flip k left),
^^^^^^^^^^^^^^^^^^
This call could be annotated.
Line 18, characters 16-39:
18 | then shift ~flip (- k) right
^^^^^^^^^^^^^^^^^^^^^^^
This call could be annotated.
Line 19, characters 16-35:
19 | else shift ~flip k right)
^^^^^^^^^^^^^^^^^^^
This call could be annotated.
|}]
module Disjunctions_disambiguated = struct
type t = Leaf of int | Node of t * t
let[@tail_mod_cons] rec shift ~flip k = function
| Leaf n -> Leaf (n + k)
| Node (left, right) ->
Node (
(if flip
then shift ~flip (- k) left
else shift ~flip k left),
(if flip
then shift ~flip (- k) right
else (shift[@tailcall]) ~flip k right)
)
end
[%%expect {|
module Disjunctions_disambiguated :
sig
type t = Leaf of int | Node of t * t
val shift : flip:bool -> int -> t -> t
end
|}]
module Disjunctions_ambiguous_again = struct
type t = Leaf of int | Node of t * t
let[@tail_mod_cons] rec shift ~flip k = function
| Leaf n -> Leaf (n + k)
| Node (left, right) ->
Node (
(if flip
then (shift[@tailcall]) ~flip (- k) left
else shift ~flip k left),
(if flip
then shift ~flip (- k) right
else (shift[@tailcall]) ~flip k right)
)
end
[%%expect {|
Lines 7-14, characters 8-9:
7 | ........Node (
8 | (if flip
9 | then (shift[@tailcall]) ~flip (- k) left
10 | else shift ~flip k left),
11 | (if flip
12 | then shift ~flip (- k) right
13 | else (shift[@tailcall]) ~flip k right)
14 | )
Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
in several different ways. Only one of the arguments may become a TMC
call, but several arguments contain calls that are explicitly marked
as tail-recursive. Please fix the conflict by reviewing and fixing the
conflicting annotations.
Line 9, characters 16-51:
9 | then (shift[@tailcall]) ~flip (- k) left
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
This call is explicitly annotated.
Line 13, characters 16-48:
13 | else (shift[@tailcall]) ~flip k right)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
This call is explicitly annotated.
|}]
|
