diff src/core_util.sml @ 522:3162bbf8e30f

Avoid Especializing polymorphic code
author Adam Chlipala <adamc@hcoop.net>
date Thu, 27 Nov 2008 12:43:28 -0500
parents ae03d09043c1
children 0dd40b6bfdf3
line wrap: on
line diff
--- a/src/core_util.sml	Thu Nov 27 12:34:44 2008 -0500
+++ b/src/core_util.sml	Thu Nov 27 12:43:28 2008 -0500
@@ -900,6 +900,30 @@
         S.Continue v => v
       | S.Return _ => raise Fail "CoreUtil.Decl.foldMapB: Impossible"
 
+fun exists {kind, con, exp, decl} d =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ()),
+                  decl = fn d => fn () =>
+                                   if decl d then
+                                       S.Return ()
+                                   else
+                                       S.Continue (d, ())} d () of
+        S.Return _ => true
+      | S.Continue _ => false
+
 end
 
 structure File = struct