summaryrefslogtreecommitdiff
path: root/testsuite/tests/tmc/other_features.ml
blob: d75e1dab0c61108623ed0200a0e0c60a92bab933 (plain)
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
(* TEST
 expect;
*)

module Non_recursive_let_bad = struct
  type 'a t =
    | N of 'a
    | C of 'a t * 'a t

  let[@tail_mod_cons] rec map f l =
    match l with
    | N v -> N (f v)
    | C (a, b) ->
        let map' l = map f l in
        C (map' a, (map' [@tailcall]) b)
end
[%%expect {|
Lines 6-11, characters 30-40:
 6 | ..............................f l =
 7 |     match l with
 8 |     | N v -> N (f v)
 9 |     | C (a, b) ->
10 |         let map' l = map f l in
11 |         C (map' a, (map' [@tailcall]) b)
Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
but is never applied in TMC position.

Line 11, characters 19-39:
11 |         C (map' a, (map' [@tailcall]) b)
                        ^^^^^^^^^^^^^^^^^^^^
Warning 51 [wrong-tailcall-expectation]: expected tailcall

Line 11, characters 19-39:
11 |         C (map' a, (map' [@tailcall]) b)
                        ^^^^^^^^^^^^^^^^^^^^
Warning 51 [wrong-tailcall-expectation]: expected tailcall

module Non_recursive_let_bad :
  sig
    type 'a t = N of 'a | C of 'a t * 'a t
    val map : ('a -> 'b) -> 'a t -> 'b t
  end
|}]


module Non_recursive_let_good = struct
  type 'a t =
    | N of 'a
    | C of 'a t * 'a t

  let[@tail_mod_cons] rec map f l =
    match l with
    | N v -> N (f v)
    | C (a, b) ->
        let[@tail_mod_cons] map' l = map f l in
        C (map' a, (map' [@tailcall]) b)
end
[%%expect {|
module Non_recursive_let_good :
  sig
    type 'a t = N of 'a | C of 'a t * 'a t
    val map : ('a -> 'b) -> 'a t -> 'b t
  end
|}]