1(* systematic tests *)
2(* these produce *alot* of output so we enclose them in a local
3   declaration *)
4(* additional declarations *)
5
6local
7signature L = sig type t = unit
8                  val x: unit
9		  exception e;
10		  prim_val p : unit -> unit = 1 "identity";
11		  structure X: sig end;
12		  functor F:functor(X:sig end)->sig end
13	      end;
14
15signature G = sig end;
16
17functor L = functor (L:L)=>
18  L:G;
19functor LL = functor(LL:functor(L:L)->L)=>
20  LL:functor(L:L)->G;
21functor GL = functor(GL:functor(L:G)->L)=>
22  GL:functor(L:L)->L;
23functor YL = functor(YL:sig structure Y:L end)=>
24  YL:sig structure Y: G end;
25functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
26  L_YL:functor(L:L)->sig structure Y: G end;
27functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
28  YG_L:functor(YL:sig structure Y: L end)->L;
29functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
30  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
31functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
32  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
33
34(* scheme match *)
35
36signature L = sig val x : ('a -> 'a) -> ('b -> 'b) end;
37signature G = sig val x : ('a -> 'a) -> ('a -> 'a) end;
38
39functor L = functor (L:L)=>
40  L:G;
41functor LL = functor(LL:functor(L:L)->L)=>
42  LL:functor(L:L)->G;
43functor GL = functor(GL:functor(L:G)->L)=>
44  GL:functor(L:L)->L;
45functor YL = functor(YL:sig structure Y:L end)=>
46  YL:sig structure Y: G end;
47functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
48  L_YL:functor(L:L)->sig structure Y: G end;
49functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
50  YG_L:functor(YL:sig structure Y: L end)->L;
51functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
52  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
53functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
54  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
55
56val 'a ok =
57let
58      signature L = sig val x : ('a -> 'a) -> ('b -> 'b) end;
59      signature G = sig val x : ('a -> 'a) -> ('a -> 'a) end;
60
61      functor L = functor (L:L)=>
62	  L:G;
63      functor LL = functor(LL:functor(L:L)->L)=>
64	  LL:functor(L:L)->G;
65      functor GL = functor(GL:functor(L:G)->L)=>
66	  GL:functor(L:L)->L;
67      functor YL = functor(YL:sig structure Y:L end)=>
68	  YL:sig structure Y: G end;
69      functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
70	  L_YL:functor(L:L)->sig structure Y: G end;
71      functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
72	  YG_L:functor(YL:sig structure Y: L end)->L;
73      functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
74	  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
75      functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
76	  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
77in ()
78end;
79
80(* status match *)
81
82signature L = sig
83                  val x: unit
84
85		  exception e;
86
87		  exception f
88
89                  datatype t = C
90
91		  prim_val p : unit -> unit = 1 "identity";
92		  prim_val q : unit -> unit = 1 "identity";
93
94	      end;
95signature G = sig
96                  val x : unit
97
98		  exception e
99
100		  val f : exn
101
102                  type t; val C : t;
103
104		  prim_val p : unit -> unit = 1 "identity";
105                  val q: unit->unit
106
107	      end;
108
109functor L = functor (L:L)=>
110  L:G;
111functor LL = functor(LL:functor(L:L)->L)=>
112  LL:functor(L:L)->G;
113functor GL = functor(GL:functor(L:G)->L)=>
114  GL:functor(L:L)->L;
115functor YL = functor(YL:sig structure Y:L end)=>
116  YL:sig structure Y: G end;
117functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
118  L_YL:functor(L:L)->sig structure Y: G end;
119functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
120  YG_L:functor(YL:sig structure Y: L end)->L;
121functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
122  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
123functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
124  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
125
126(* opaque match *)
127signature L = sig type t
128                  type u = unit
129                  type v = unit -> unit
130		  datatype w = C of unit
131		  datatype x = F of unit -> unit
132		  eqtype z
133
134		  eqtype e
135		  type f = unit
136		  datatype g = D of unit
137
138		  prim_EQtype p
139		  prim_EQtype q
140		  prim_EQtype r
141	      end;
142signature G = sig type t
143                  type u
144		  type v
145		  type w
146		  type x
147		  type z
148
149		  eqtype e
150		  eqtype f
151		  eqtype g
152
153		  prim_EQtype p
154		  type q
155		  eqtype r
156	      end;
157
158functor L = functor (L:L)=>
159  L:G;
160functor LL = functor(LL:functor(L:L)->L)=>
161  LL:functor(L:L)->G;
162functor GL = functor(GL:functor(L:G)->L)=>
163  GL:functor(L:L)->L;
164functor YL = functor(YL:sig structure Y:L end)=>
165  YL:sig structure Y: G end;
166functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
167  L_YL:functor(L:L)->sig structure Y: G end;
168functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
169  YG_L:functor(YL:sig structure Y: L end)->L;
170functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
171  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
172functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
173  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
174
175
176(* transparent match *)
177
178signature L = sig type ('a,'b) t = 'a * 'b end;
179signature G = sig type ('c,'d) t = 'c * 'd end;
180
181functor L = functor (L:L)=>
182  L:G;
183functor LL = functor(LL:functor(L:L)->L)=>
184  LL:functor(L:L)->G;
185functor GL = functor(GL:functor(L:G)->L)=>
186  GL:functor(L:L)->L;
187functor YL = functor(YL:sig structure Y:L end)=>
188  YL:sig structure Y: G end;
189functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
190  L_YL:functor(L:L)->sig structure Y: G end;
191functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
192  YG_L:functor(YL:sig structure Y: L end)->L;
193functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
194  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
195functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
196  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
197
198(* eta match *)
199
200signature L = sig
201		  type t
202		  type u = t
203
204		  type 'a t1
205		  type 'a u1 = 'a t1
206
207		  type ('a,'b) t2
208		  type ('a,'b) u2 = ('a,'b) t2
209
210		  datatype d = C | D of d
211		  structure E : sig datatype e = datatype d end
212
213		  datatype 'a d1 = C1 of 'a | D1 of 'a d1
214		  structure E1 : sig datatype e1 = datatype d1 end
215
216		  datatype ('a,'b) d2 =  C2 of 'a * 'b | D2 of ('b,'a) d2
217		  structure E2 : sig datatype e2 = datatype d2 end
218	      end;
219signature G = sig
220		  type  u
221		  type  t = u
222
223		  type 'a u1
224		  type 'a t1 = 'a u1
225
226		  type ('a,'b) u2
227		  type ('a,'b) t2 = ('a,'b) u2
228
229		  structure E : sig datatype e = C | D of e  end
230		  datatype d = datatype E.e
231
232		  structure E1 : sig datatype 'a e1 = C1 of 'a | D1 of 'a e1 end
233		  datatype d1 = datatype E1.e1
234
235		  structure E2 : sig datatype ('a,'b) e2 = C2 of 'a * 'b | D2 of ('b,'a) e2  end
236		  datatype d2 = datatype E2.e2
237
238	      end;
239
240functor L = functor (L:L)=>
241  L:G;
242functor LL = functor(LL:functor(L:L)->L)=>
243  LL:functor(L:L)->G;
244functor GL = functor(GL:functor(L:G)->L)=>
245  GL:functor(L:L)->L;
246functor YL = functor(YL:sig structure Y:L end)=>
247  YL:sig structure Y: G end;
248functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
249  L_YL:functor(L:L)->sig structure Y: G end;
250functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
251  YG_L:functor(YL:sig structure Y: L end)->L;
252functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
253  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
254functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
255  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
256
257(* datatype match *)
258
259structure X = struct
260		  datatype t = C of (t,unit u) v
261		  and 'a u = D of t
262		  and ('a,'b) v = E of ('a * 'b) u
263	      end
264signature L = sig datatype t = C of (t,unit u) v
265		  and 'a u = D of t
266		  and ('a,'b) v = E of ('a * 'b) u
267		  structure X : sig datatype t = datatype X.t
268		                    datatype u = datatype X.u
269				    datatype v = datatype X.v
270				end
271		  structure Y : sig datatype t = datatype X.t
272		                    datatype u = datatype X.u
273				    datatype v = datatype X.v
274				end
275	      end;
276signature G = sig datatype t = C of (t,unit u) v
277		  and 'a u = D of t
278		  and ('a,'b) v = E of ('a * 'b) u
279		  structure X : sig datatype t = datatype X.t
280				    datatype u = datatype X.u
281				    datatype v = datatype X.v
282				end
283		  structure Y : sig datatype t = C of (t,unit u) v
284				    and 'a u = D of t
285				    and ('a,'b) v = E of ('a * 'b) u
286				end
287	      end;
288
289functor L = functor (L:L)=>
290
291  L:G;
292functor LL = functor(LL:functor(L:L)->L)=>
293  LL:functor(L:L)->G;
294functor GL = functor(GL:functor(L:G)->L)=>
295  GL:functor(L:L)->L;
296functor YL = functor(YL:sig structure Y:L end)=>
297  YL:sig structure Y: G end;
298functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
299  L_YL:functor(L:L)->sig structure Y: G end;
300functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
301  YG_L:functor(YL:sig structure Y: L end)->L;
302functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
303  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
304functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
305  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
306
307(* applicative/generative match *)
308
309signature L = functor X:sig type t end ->sig type u end;
310signature G = functor(X:sig type t end)->sig type u end;
311
312functor L = functor (L:L)=>
313  L:G;
314functor LL = functor(LL:functor(L:L)->L)=>
315  LL:functor(L:L)->G;
316functor GL = functor(GL:functor(L:G)->L)=>
317  GL:functor(L:L)->L;
318
319(*  applicative generative match (cont.)
320    we need to embed the functors in structures for these tests
321*)
322
323signature L = sig functor F: functor  X:sig type t end ->sig type u end end;
324signature G = sig functor F: functor(X:sig type t end)->sig type u end end;
325
326functor YL = functor(YL:sig structure Y:L end)=>
327  YL:sig structure Y: G end;
328functor L_YL = functor(L_YL:functor(L:L)->sig structure Y:L end)=>
329  L_YL:functor(L:L)->sig structure Y: G end;
330functor YG_L = functor(YG_L:functor(YG:sig structure Y:G end)->L)=>
331  YG_L:functor(YL:sig structure Y: L end)->L;
332functor L_YG_L = functor(L_YG_L:functor(L:L)->functor(YG:sig structure Y:G end)->L)=>
333  L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L;
334functor FLYGL = functor(FLYGL:sig functor F: functor(L:L)->functor(YG:sig structure Y:G end)->L end)=>
335  FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end;
336
337(* end of tests *)
338in
339    val matchsuc = "OK"
340end;
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358