1{-# LANGUAGE ApplicativeDo #-}
2{-# OPTIONS_GHC -ddump-types #-}
3module Test where
4
5-- This is a do expression that typechecks with only an Applicative constraint
6test1 :: Applicative f => (Int -> f Int) -> f Int
7test1 f = do
8  x <- f 3
9  y <- f 4
10  return (x + y)
11
12-- Test we can also infer the Applicative version of the type
13test2 f = do
14  x <- f 3
15  y <- f 4
16  return (x + y)
17
18-- This one will use join
19test3 f g = do
20  x <- f 3
21  y <- f 4
22  g y x
23
24-- This one needs a tuple
25test4 f g = do
26  x <- f 3
27  y <- f 4
28  let r = g y x
29  r
30
31-- This one used to need a big tuple, now it compiles to ApplicativeLastStmt
32test5 f g = do
33  x01 <- f 01
34  x02 <- f 02
35  x03 <- f 03
36  x04 <- f 04
37  x05 <- f 05
38  x06 <- f 06
39  x07 <- f 07
40  x08 <- f 08
41  x09 <- f 09
42  x11 <- f 11
43  x12 <- f 12
44  x13 <- f 13
45  x14 <- f 14
46  x15 <- f 15
47  x16 <- f 16
48  x17 <- f 17
49  x18 <- f 18
50  x19 <- f 19
51  x20 <- f 20
52  x21 <- f 21
53  x22 <- f 22
54  x23 <- f 23
55  x24 <- f 24
56  x25 <- f 25
57  x26 <- f 26
58  x27 <- f 27
59  x28 <- f 28
60  x29 <- f 29
61  x30 <- f 30
62  x31 <- f 31
63  x32 <- f 32
64  x33 <- f 33
65  x34 <- f 34
66  x35 <- f 35
67  x36 <- f 36
68  x37 <- f 37
69  x38 <- f 38
70  x39 <- f 39
71  x40 <- f 40
72  x41 <- f 41
73  x42 <- f 42
74  x43 <- f 43
75  x44 <- f 44
76  x45 <- f 45
77  x46 <- f 46
78  x47 <- f 47
79  x48 <- f 48
80  x49 <- f 49
81  x50 <- f 50
82  x51 <- f 51
83  x52 <- f 52
84  x53 <- f 53
85  x54 <- f 54
86  x55 <- f 55
87  x56 <- f 56
88  x57 <- f 57
89  x58 <- f 58
90  x59 <- f 59
91  x60 <- f 60
92  x61 <- f 61
93  x62 <- f 62
94  x63 <- f 63
95  x64 <- f 64
96  x65 <- f 65
97  x66 <- f 66
98  x67 <- f 67
99  x68 <- f 68
100  x69 <- f 69
101  x70 <- f 70
102  let r = g x70 x01
103  r
104
105-- This one needs a big tuple
106test6 f g = do
107  x01 <- f 01
108  x02 <- f 02
109  x03 <- f 03
110  x04 <- f 04
111  x05 <- f 05
112  x06 <- f 06
113  x07 <- f 07
114  x08 <- f 08
115  x09 <- f 09
116  x11 <- f 11
117  x12 <- f 12
118  x13 <- f 13
119  x14 <- f 14
120  x15 <- f 15
121  x16 <- f 16
122  x17 <- f 17
123  x18 <- f 18
124  x19 <- f 19
125  x20 <- f 20
126  x21 <- f 21
127  x22 <- f 22
128  x23 <- f 23
129  x24 <- f 24
130  x25 <- f 25
131  x26 <- f 26
132  x27 <- f 27
133  x28 <- f 28
134  x29 <- f 29
135  x30 <- f 30
136  x31 <- f 31
137  x32 <- f 32
138  x33 <- f 33
139  x34 <- f 34
140  x35 <- f 35
141  x36 <- f 36
142  x37 <- f 37
143  x38 <- f 38
144  x39 <- f 39
145  x40 <- f 40
146  x41 <- f 41
147  x42 <- f 42
148  x43 <- f 43
149  x44 <- f 44
150  x45 <- f 45
151  x46 <- f 46
152  x47 <- f 47
153  x48 <- f 48
154  x49 <- f 49
155  x50 <- f 50
156  x51 <- f 51
157  x52 <- f 52
158  x53 <- f 53
159  x54 <- f 54
160  x55 <- f 55
161  x56 <- f 56
162  x57 <- f 57
163  x58 <- f 58
164  x59 <- f 59
165  x60 <- f 60
166  x61 <- f 61
167  x62 <- f 62
168  x63 <- f 63
169  x64 <- f 64
170  x65 <- f 65
171  x66 <- f 66
172  x67 <- f 67
173  x68 <- f 68
174  x69 <- f 69
175  x70 <- f x01
176  x71 <- f 70
177  x71 `const`
178   [ x01
179   , x02
180   , x03
181   , x04
182   , x05
183   , x06
184   , x07
185   , x08
186   , x09
187   , x11
188   , x12
189   , x13
190   , x14
191   , x15
192   , x16
193   , x17
194   , x18
195   , x19
196   , x20
197   , x21
198   , x22
199   , x23
200   , x24
201   , x25
202   , x26
203   , x27
204   , x28
205   , x29
206   , x30
207   , x31
208   , x32
209   , x33
210   , x34
211   , x35
212   , x36
213   , x37
214   , x38
215   , x39
216   , x40
217   , x41
218   , x42
219   , x43
220   , x44
221   , x45
222   , x46
223   , x47
224   , x48
225   , x49
226   , x50
227   , x51
228   , x52
229   , x53
230   , x54
231   , x55
232   , x56
233   , x57
234   , x58
235   , x59
236   , x60
237   , x61
238   , x62
239   , x63
240   , x64
241   , x65
242   , x66
243   , x67
244   , x68
245   , x69
246   , x70
247   , x71 ]
248