Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | structure Z = |
2 | struct | |
3 | ||
4 | structure Thread = MLton.Thread | |
5 | ||
6 | fun generate(f: ('a -> unit) -> unit): unit -> 'a option = | |
7 | let | |
8 | val paused: 'a option Thread.t option ref = ref NONE | |
9 | val gen: unit Thread.t option ref = ref NONE | |
10 | fun return(a: 'a option): unit = | |
11 | Thread.switch(fn t' => | |
12 | let val _ = gen := SOME t' | |
13 | val t = valOf(!paused) | |
14 | val _ = paused := NONE | |
15 | in Thread.prepare (t, a) | |
16 | end) | |
17 | val _ = | |
18 | gen := SOME(Thread.new(fn () => (f (return o SOME) | |
19 | ; return NONE))) | |
20 | in fn () => Thread.switch(fn t => (paused := SOME t | |
21 | ; Thread.prepare (valOf(!gen), ()))) | |
22 | end | |
23 | ||
24 | datatype 'a tree = | |
25 | L of 'a | |
26 | | N of 'a tree * 'a tree | |
27 | ||
28 | fun foreach(t: 'a tree, f: 'a -> unit): unit = | |
29 | let | |
30 | val rec loop = | |
31 | fn L a => f a | |
32 | | N(l, r) => (loop l; loop r) | |
33 | in loop t | |
34 | end | |
35 | ||
36 | fun same(f: unit -> 'a option, | |
37 | g: unit -> 'a option, | |
38 | eq: 'a * 'a -> bool): bool = | |
39 | let | |
40 | fun loop() = | |
41 | case (f(), g()) of | |
42 | (NONE, NONE) => true | |
43 | | (SOME x, SOME y) => eq(x, y) andalso loop() | |
44 | | _ => false | |
45 | in loop() | |
46 | end | |
47 | ||
48 | fun fringe(t: 'a tree): unit -> 'a option = | |
49 | generate(fn f => foreach(t, f)) | |
50 | ||
51 | fun sameFringe(t1: 'a tree, t2: 'a tree, eq: 'a * 'a -> bool): bool = | |
52 | same(fringe t1, fringe t2, eq) | |
53 | ||
54 | val t1 = N(N(L 1, L 2), N(N(L 3, L 4), L 5)) | |
55 | val t2 = N(L 1, N(N(L 2, L 3), N(L 4, L 5))) | |
56 | ||
57 | val _ = | |
58 | if sameFringe(t1, t2, op =) | |
59 | then print "success\n" | |
60 | else print "failure\n" | |
61 | ||
62 | end |