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
|
(* TEST
* expect *)
(* build-up *)
let[@tail_mod_cons] rec append xs ys =
match xs with
| [] -> ys
| x :: xs -> x :: append xs ys
[%%expect {|
val append : 'a list -> 'a list -> 'a list = <fun>
|}]
(* incorrect version: this cannot work *)
let[@tail_mod_cons] rec flatten = function
| [] -> []
| xs :: xss -> append xs (flatten xss)
[%%expect {|
Line 3, characters 17-40:
3 | | xs :: xss -> append xs (flatten xss)
^^^^^^^^^^^^^^^^^^^^^^^
Warning 72 [tmc-breaks-tailcall]: This call
is in tail-modulo-cons position in a TMC function,
but the function called is not itself specialized for TMC,
so the call will not be transformed into a tail call.
Please either mark the called function with the [@tail_mod_cons]
attribute, or mark this call with the [@tailcall false] attribute
to make its non-tailness explicit.
Lines 1-3, characters 34-40:
1 | ..................................function
2 | | [] -> []
3 | | xs :: xss -> append xs (flatten xss)
Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
but is never applied in TMC position.
val flatten : 'a list list -> 'a list = <fun>
|}]
(* correct version *)
let[@tail_mod_cons] rec flatten = function
| [] -> []
| xs :: xss ->
let[@tail_mod_cons] rec append_flatten xs xss =
match xs with
| [] -> flatten xss
| x :: xs -> x :: append_flatten xs xss
in append_flatten xs xss
[%%expect {|
val flatten : 'a list list -> 'a list = <fun>
|}]
(* incorrect version *)
let[@tail_mod_cons] rec flatten = function
| [] -> []
| xs :: xss ->
let rec append_flatten xs xss =
match xs with
| [] -> flatten xss
| x :: xs ->
(* incorrect: this call to append_flatten is not transformed *)
x :: append_flatten xs xss
in append_flatten xs xss
[%%expect {|
Line 10, characters 9-30:
10 | in append_flatten xs xss
^^^^^^^^^^^^^^^^^^^^^
Warning 72 [tmc-breaks-tailcall]: This call
is in tail-modulo-cons position in a TMC function,
but the function called is not itself specialized for TMC,
so the call will not be transformed into a tail call.
Please either mark the called function with the [@tail_mod_cons]
attribute, or mark this call with the [@tailcall false] attribute
to make its non-tailness explicit.
Lines 1-10, characters 34-30:
1 | ..................................function
2 | | [] -> []
3 | | xs :: xss ->
4 | let rec append_flatten xs xss =
5 | match xs with
6 | | [] -> flatten xss
7 | | x :: xs ->
8 | (* incorrect: this call to append_flatten is not transformed *)
9 | x :: append_flatten xs xss
10 | in append_flatten xs xss
Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
but is never applied in TMC position.
val flatten : 'a list list -> 'a list = <fun>
|}]
(* incorrect version: the call to append-flatten is not transformed *)
let rec flatten = function
| [] -> []
| xs :: xss ->
let[@tail_mod_cons] rec append_flatten xs xss =
match xs with
| [] ->
(* incorrect: if flatten does not have a TMC version,
this call is not tail-recursive in the TMC version of
append-flatten, so this version is in fact equivalent
to the "cannot work" version above: the "append" part
runs in constant stack space, but the "flatten" part is
not tail-recursive. *)
flatten xss
| x :: xs ->
x :: append_flatten xs xss
in append_flatten xs xss
[%%expect {|
Line 13, characters 12-23:
13 | flatten xss
^^^^^^^^^^^
Warning 72 [tmc-breaks-tailcall]: This call
is in tail-modulo-cons position in a TMC function,
but the function called is not itself specialized for TMC,
so the call will not be transformed into a tail call.
Please either mark the called function with the [@tail_mod_cons]
attribute, or mark this call with the [@tailcall false] attribute
to make its non-tailness explicit.
val flatten : 'a list list -> 'a list = <fun>
|}]
module Tail_calls_to_non_specialized_functions = struct
(* This module contains regression tests for some delicate warning behavior:
if the list_id call below goes to a non-specialized function,
it gets the "use [@tailcall false]" warning, but it is in tailcall
position in the direct-style version, so it could also get the
"invalid [@tailcall false] assumption" warning. *)
(* *not* TMC-specialized *)
let list_id = function
| [] -> []
| x :: xs -> x :: xs
let[@tail_mod_cons] rec filter_1 f li =
match li with
| [] -> []
| x :: xs ->
if f x
then x :: filter_1 f xs
else
list_id
(* no [@tailcall false]: this should warn that
the call becomes non-tailcall in the TMC version. *)
(filter_1 f xs)
let[@tail_mod_cons] rec filter_2 f li =
match li with
| [] -> []
| x :: xs ->
if f x
then x :: filter_2 f xs
else
(list_id[@tailcall false])
(* [@tailcall false]: this should *not* warn that
the call is in fact in tail position in the direct version. *)
(filter_2 f xs)
end
[%%expect {|
Lines 20-23, characters 10-27:
20 | ..........list_id
21 | (* no [@tailcall false]: this should warn that
22 | the call becomes non-tailcall in the TMC version. *)
23 | (filter_1 f xs)
Warning 72 [tmc-breaks-tailcall]: This call
is in tail-modulo-cons position in a TMC function,
but the function called is not itself specialized for TMC,
so the call will not be transformed into a tail call.
Please either mark the called function with the [@tail_mod_cons]
attribute, or mark this call with the [@tailcall false] attribute
to make its non-tailness explicit.
module Tail_calls_to_non_specialized_functions :
sig
val list_id : 'a list -> 'a list
val filter_1 : ('a -> bool) -> 'a list -> 'a list
val filter_2 : ('a -> bool) -> 'a list -> 'a list
end
|}]
module All_annotations_correctly_used = struct
type 'a t =
| N of 'a
| Graft of int
| Tau of 'a t
| C of 'a t * 'a t
let[@inline never] rec graft n =
graft n
let[@tail_mod_cons] rec map f l =
(* this function should never warn *)
match l with
| N v -> N (f v)
| Graft n ->
if n >= 0
then (graft[@tailcall false]) n
else Tau ((graft[@tailcall false]) n)
| Tau t -> (map[@tailcall]) f t
| C (a, b) ->
let[@tail_mod_cons] map' l = map f l in
C (map' a, (map' [@tailcall]) b)
end
[%%expect {|
module All_annotations_correctly_used :
sig
type 'a t = N of 'a | Graft of int | Tau of 'a t | C of 'a t * 'a t
val graft : 'a -> 'b
val map : ('a -> 'b) -> 'a t -> 'b t
end
|}]
module All_annotations_flipped = struct
type 'a t =
| N of 'a
| Graft of int
| Tau of 'a t
| C of 'a t * 'a t
let[@inline never] rec graft n =
graft n
let[@tail_mod_cons] rec map_wrong f l =
match l with
| N v -> N (f v)
| Graft n ->
if n >= 0
then (graft[@tailcall]) (* this should warn *) n
else Tau ((graft[@tailcall]) (* this should also warn *) n)
| Tau t ->
(map_wrong[@tailcall false])
(* this attribute disables the TMC call here,
so it does generate non-tail code:
the annotation is erased in direct-style, kept in DPS,
and the generated code must not warn. *)
f t
| C (a, b) ->
let[@tail_mod_cons] map' l = map_wrong f l in
C (map' a,
(map' [@tailcall false])
(* this attribute results in the other map' being selected for TMC,
no warning here. *)
b)
end
[%%expect {|
Line 16, characters 13-56:
16 | then (graft[@tailcall]) (* this should warn *) n
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 72 [tmc-breaks-tailcall]: This call
is in tail-modulo-cons position in a TMC function,
but the function called is not itself specialized for TMC,
so the call will not be transformed into a tail call.
Please either mark the called function with the [@tail_mod_cons]
attribute, or mark this call with the [@tailcall false] attribute
to make its non-tailness explicit.
Line 17, characters 17-67:
17 | else Tau ((graft[@tailcall]) (* this should also warn *) n)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 51 [wrong-tailcall-expectation]: expected tailcall
Line 16, characters 13-56:
16 | then (graft[@tailcall]) (* this should warn *) n
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 51 [wrong-tailcall-expectation]: expected tailcall
Line 17, characters 17-67:
17 | else Tau ((graft[@tailcall]) (* this should also warn *) n)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 51 [wrong-tailcall-expectation]: expected tailcall
module All_annotations_flipped :
sig
type 'a t = N of 'a | Graft of int | Tau of 'a t | C of 'a t * 'a t
val graft : 'a -> 'b
val map_wrong : ('a -> 'b) -> 'a t -> 'b t
end
|}]
|
