1 # The 'same fringe' problem: http://wiki.c2.com/?SameFringeProblem
 2 # Example program demonstrating coroutines using Mu's delimited continuations.
 3 #
 4 # Expected output:
 5 #   1
 6 # (i.e. that the two given trees x and y have the same leaves, in the same
 7 # order from left to right)
 8 
 9 container tree:_elem [
10   val:_elem
11   left:&:tree:_elem
12   right:&:tree:_elem
13 ]
14 
15 def main [
16   local-scope
17   # x: ((a b) c)
18   # y: (a (b c))
19   a:&:tree:num <- new-tree 3
20   b:&:tree:num <- new-tree 4
21   c:&:tree:num <- new-tree 5
22   x1:&:tree:num <- new-tree a, b
23   x:&:tree:num <- new-tree x1, c
24   y1:&:tree:num <- new-tree b, c
25   y:&:tree:num <- new-tree a, y1
26   result:bool <- same-fringe x, y
27   $print result 10/newline
28 ]
29 
30 def same-fringe a:&:tree:_elem, b:&:tree:_elem -> result:bool [
31   local-scope
32   load-inputs
33   k1:continuation <- call-with-continuation-mark 100/mark, process, a
34   k2:continuation <- call-with-continuation-mark 100/mark, process, b
35   {
36     k1, x:_elem, a-done?:bool <- call k1
37     k2, y:_elem, b-done?:bool <- call k2
38     break-if a-done?
39     break-if b-done?
40     match?:bool <- equal x, y
41     return-unless match?, false
42     loop
43   }
44   result <- and a-done?, b-done?
45 ]
46 
47 # harness around traversal
48 def process t:&:tree:_elem [
49   local-scope
50   load-inputs
51   return-continuation-until-mark 100/mark  # initial
52   traverse t
53   zero-val:&:_elem <- new _elem:type
54   return-continuation-until-mark 100/mark, *zero-val, true/done  # final
55   assert false, [continuation called past done]
56 ]
57 
58 # core traversal
59 def traverse t:&:tree:_elem [
60   local-scope
61   load-inputs
62   return-unless t
63   l:&:tree:_elem <- get *t, left:offset
64   traverse l
65   r:&:tree:_elem <- get *t, right:offset
66   traverse r
67   return-if l
68   return-if r
69   # leaf
70   v:_elem <- get *t, val:offset
71   return-continuation-until-mark 100/mark, v, false/not-done
72 ]
73 
74 # details
75 
76 def new-tree x:_elem -> result:&:tree:_elem [
77   local-scope
78   load-inputs
79   result <- new {(tree _elem): type}
80   put *result, val:offset, x
81 ]
82 
83 def new-tree l:&:tree:_elem, r:&:tree:_elem -> result:&:tree:_elem [
84   local-scope
85   load-inputs
86   result <- new {(tree _elem): type}
87   put *result, left:offset, l
88   put *result, right:offset, r
89 ]