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
|
# The 'same fringe' problem: http://wiki.c2.com/?SameFringeProblem
# Example program demonstrating coroutines using Mu's delimited continuations.
#
# Expected output:
# 1
# (i.e. that the two given trees x and y have the same leaves, in the same
# order from left to right)
container tree:_elem [
val:_elem
left:&:tree:_elem
right:&:tree:_elem
]
def main [
local-scope
# x: ((a b) c)
# y: (a (b c))
a:&:tree:num <- new-tree 3
b:&:tree:num <- new-tree 4
c:&:tree:num <- new-tree 5
x1:&:tree:num <- new-tree a, b
x:&:tree:num <- new-tree x1, c
y1:&:tree:num <- new-tree b, c
y:&:tree:num <- new-tree a, y1
result:bool <- same-fringe x, y
$print result 10/newline
]
def same-fringe a:&:tree:_elem, b:&:tree:_elem -> result:bool [
local-scope
load-inputs
k1:continuation <- call-with-continuation-mark 100/mark, process, a
k2:continuation <- call-with-continuation-mark 100/mark, process, b
{
k1, x:_elem, a-done?:bool <- call k1
k2, y:_elem, b-done?:bool <- call k2
break-if a-done?
break-if b-done?
match?:bool <- equal x, y
return-unless match?, false
loop
}
result <- and a-done?, b-done?
]
# harness around traversal
def process t:&:tree:_elem [
local-scope
load-inputs
return-continuation-until-mark 100/mark # initial
traverse t
zero-val:&:_elem <- new _elem:type
return-continuation-until-mark 100/mark, *zero-val, true/done # final
assert false, [continuation called past done]
]
# core traversal
def traverse t:&:tree:_elem [
local-scope
load-inputs
return-unless t
l:&:tree:_elem <- get *t, left:offset
traverse l
r:&:tree:_elem <- get *t, right:offset
traverse r
return-if l
return-if r
# leaf
v:_elem <- get *t, val:offset
return-continuation-until-mark 100/mark, v, false/not-done
]
# details
def new-tree x:_elem -> result:&:tree:_elem [
local-scope
load-inputs
result <- new {(tree _elem): type}
put *result, val:offset, x
]
def new-tree l:&:tree:_elem, r:&:tree:_elem -> result:&:tree:_elem [
local-scope
load-inputs
result <- new {(tree _elem): type}
put *result, left:offset, l
put *result, right:offset, r
]
|