90 lines
2.1 KiB
Forth
90 lines
2.1 KiB
Forth
# 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
|
|
]
|