File: tailcalls.ml

package info (click to toggle)
js-of-ocaml 6.2.0-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 37,932 kB
  • sloc: ml: 135,957; javascript: 58,364; ansic: 437; makefile: 422; sh: 12; perl: 4
file content (92 lines) | stat: -rw-r--r-- 3,414 bytes parent folder | download | duplicates (2)
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
(* TEST *)

let rec tailcall4 a b c d =
  if a < 0
  then b
  else tailcall4 (a-1) (b+1) (c+2) (d+3)

let rec tailcall8 a b c d e f g h =
  if a < 0
  then b
  else tailcall8 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)

let rec tailcall16 a b c d e f g h i j k l m n o p =
  if a < 0
  then b
  else tailcall16 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
                  (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)

let rec tailcall32 a b c d e f g h i j k l m n o p
                   q r s t u v w x y z aa bb cc dd ee ff =
  if a < 0
  then b
  else tailcall32 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
                  (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
                  (q+16) (r+17) (s+18) (t+19) (u+20) (v+21) (w+22) (x+23)
                  (y+24) (z+25) (aa+26) (bb+27) (cc+28) (dd+29) (ee+30) (ff+31)

let indtailcall8 fn a b c d e f g h =
  fn a b c d e f g h

let indtailcall16 fn a b c d e f g h i j k l m n o p =
  fn a b c d e f g h i j k l m n o p

let rec muttailcall8 a b c d e f g h =
  if a < 0
  then b
  else auxtailcall8 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)

and auxtailcall8 a b c d e f g h =
  muttailcall8 a b c d e f g h

let rec muttailcall16 a b c d e f g h i j k l m n o p =
  if a < 0
  then b
  else auxtailcall16 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
                     (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)

and auxtailcall16 a b c d e f g h i j k l m n o p =
  muttailcall16 a b c d e f g h i j k l m n o p

let rec muttailcall32 a b c d e f g h i j k l m n o p
                   q r s t u v w x y z aa bb cc dd ee ff =
  if a < 0
  then b
  else auxtailcall32 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
                  (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
                  (q+16) (r+17) (s+18) (t+19) (u+20) (v+21) (w+22) (x+23)
                  (y+24) (z+25) (aa+26) (bb+27) (cc+28) (dd+29) (ee+30) (ff+31)

and auxtailcall32 a b c d e f g h i j k l m n o p
                  q r s t u v w x y z aa bb cc dd ee ff =
  muttailcall32 a b c d e f g h i j k l m n o p
                q r s t u v w x y z aa bb cc dd ee ff

(* regression test for PR#6441: *)
let rec tailcall16_value_closures a b c d e f g h i j k l m n o p =
  if a < 0
  then b
  else tailcall16_value_closures
         (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
         (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
and fs = [tailcall16_value_closures]

let _ =
  print_int (tailcall4 10000000 0 0 0); print_newline();
  print_int (tailcall8 10000000 0 0 0 0 0 0 0); print_newline();
  print_int (tailcall16 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline();
  print_int (tailcall32 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
                               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline();
  print_int (indtailcall8 tailcall8 10 0 0 0 0 0 0 0); print_newline();
  print_int (indtailcall16 tailcall16 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline();
  print_int (tailcall16_value_closures 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline();
  print_int (muttailcall8 10000000 0 0 0 0 0 0 0); print_newline();
  print_int (muttailcall16 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline();
  print_int (muttailcall32 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
                                  0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
  print_newline()