Mercurial > urweb
diff src/elab_util.sml @ 711:7292bcb7c02d
Made type class system very general; demo compiles
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 09 Apr 2009 12:31:56 -0400 |
| parents | d8217b4cb617 |
| children | f152f215a02c |
line wrap: on
line diff
--- a/src/elab_util.sml Tue Apr 07 20:38:01 2009 -0400 +++ b/src/elab_util.sml Thu Apr 09 12:31:56 2009 -0400 @@ -244,7 +244,22 @@ S.Return () => raise Fail "ElabUtil.Con.map: Impossible" | S.Continue (s, ()) => s -fun exists {kind, con} k = +fun existsB {kind, con, bind} ctx c = + case mapfoldB {kind = fn ctx => fn k => fn () => + if kind (ctx, k) then + S.Return () + else + S.Continue (k, ()), + con = fn ctx => fn c => fn () => + if con (ctx, c) then + S.Return () + else + S.Continue (c, ()), + bind = bind} ctx c () of + S.Return _ => true + | S.Continue _ => false + +fun exists {kind, con} c = case mapfold {kind = fn k => fn () => if kind k then S.Return () @@ -254,7 +269,7 @@ if con c then S.Return () else - S.Continue (c, ())} k () of + S.Continue (c, ())} c () of S.Return _ => true | S.Continue _ => false