From 960a42fc1844d5f0f6033b3caada6349d588a2a9 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 27 Nov 2008 12:43:28 -0500 Subject: Avoid Especializing polymorphic code --- src/core_util.sml | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'src/core_util.sml') diff --git a/src/core_util.sml b/src/core_util.sml index 71efe16e..02cb86ca 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -900,6 +900,30 @@ fun foldMapB {kind, con, exp, decl, bind} ctx s d = 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 -- cgit v1.2.3