summaryrefslogtreecommitdiff
path: root/src/core_util.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-09 16:54:42 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-09 16:54:42 -0500
commit6d1ea82d46cb6f34b45d6e5abab29cacf006f1fb (patch)
tree48a83b81a63f0a0fddbda35a618ef1602b59627c /src/core_util.sml
parentb1e02a9df5f341b5e1298085df0aef70f11ae424 (diff)
Defunctionalization gets CommentBlog working
Diffstat (limited to 'src/core_util.sml')
-rw-r--r--src/core_util.sml17
1 files changed, 17 insertions, 0 deletions
diff --git a/src/core_util.sml b/src/core_util.sml
index 4d72f57e..f7e92f51 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -709,6 +709,14 @@ fun fold {kind, con, exp} s e =
S.Continue (_, s) => s
| S.Return _ => raise Fail "CoreUtil.Exp.fold: Impossible"
+fun foldB {kind, con, exp, bind} ctx s e =
+ case mapfoldB {kind = fn k => fn s => S.Continue (k, kind (k, s)),
+ con = fn ctx => fn c => fn s => S.Continue (c, con (ctx, c, s)),
+ exp = fn ctx => fn e => fn s => S.Continue (e, exp (ctx, e, s)),
+ bind = bind} ctx e s of
+ S.Continue (_, s) => s
+ | S.Return _ => raise Fail "CoreUtil.Exp.foldB: Impossible"
+
fun exists {kind, con, exp} k =
case mapfold {kind = fn k => fn () =>
if kind k then
@@ -861,6 +869,15 @@ fun foldMap {kind, con, exp, decl} s d =
S.Continue v => v
| S.Return _ => raise Fail "CoreUtil.Decl.foldMap: Impossible"
+fun foldMapB {kind, con, exp, decl, bind} ctx s d =
+ case mapfoldB {kind = fn k => fn s => S.Continue (kind (k, s)),
+ con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)),
+ exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
+ decl = fn ctx => fn d => fn s => S.Continue (decl (ctx, d, s)),
+ bind = bind} ctx d s of
+ S.Continue v => v
+ | S.Return _ => raise Fail "CoreUtil.Decl.foldMapB: Impossible"
+
end
structure File = struct