4154

All the bugfixes since commit 4135 have been aimed at getting this
example program work.

1 files changed, 89 insertions, 0 deletions

diff --git a/same-fringe.mu b/same-fringe.mu
new file mode 100644
index 00000000..828ef6c4
--- /dev/null
+++ b/same-fringe.mu
@@ -0,0 +1,89 @@
+# Another example of continuations: the 'same fringe' problem:
+#   http://wiki.c2.com/?SameFringeProblem
+#
+# 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 process, a
+  k2:continuation <- call-with-continuation-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?, 0/false
+    loop
+  }
+  result <- and a-done?, b-done?
+]
+
+# harness around traversal
+def process t:&:tree:_elem [
+  local-scope
+  load-inputs
+  return-continuation-until-mark  # initial
+  traverse t
+  zero-val:&:_elem <- new _elem:type
+  return-continuation-until-mark *zero-val, 1/done  # final
+  assert 0/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 v, 0/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
+]