Mercurial > urweb
changeset 522:3162bbf8e30f
Avoid Especializing polymorphic code
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 27 Nov 2008 12:43:28 -0500 |
| parents | 31aba58a5b5b |
| children | 612001c39ed6 |
| files | src/core_util.sig src/core_util.sml src/especialize.sml |
| diffstat | 3 files changed, 40 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/src/core_util.sig Thu Nov 27 12:34:44 2008 -0500 +++ b/src/core_util.sig Thu Nov 27 12:43:28 2008 -0500 @@ -165,6 +165,11 @@ decl : 'context * Core.decl' * 'state -> Core.decl' * 'state, bind : 'context * binder -> 'context} -> 'context -> 'state -> Core.decl -> Core.decl * 'state + + val exists : {kind : Core.kind' -> bool, + con : Core.con' -> bool, + exp : Core.exp' -> bool, + decl : Core.decl' -> bool} -> Core.decl -> bool end structure File : sig
--- 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
--- a/src/especialize.sml Thu Nov 27 12:34:44 2008 -0500 +++ b/src/especialize.sml Thu Nov 27 12:43:28 2008 -0500 @@ -59,6 +59,12 @@ | _ => bound} 0 IS.empty +val isPoly = U.Decl.exists {kind = fn _ => false, + con = fn _ => false, + exp = fn ECAbs _ => true + | _ => false, + decl = fn _ => false} + fun positionOf (v : int, ls) = let fun pof (pos, ls) = @@ -302,7 +308,11 @@ (*val () = Print.prefaces "decl" [("d", CorePrint.p_decl CoreEnv.empty d)]*) - val (d', st) = specDecl [] st d + val (d', st) = + if isPoly d then + (d, st) + else + specDecl [] st d (*val () = print "/decl\n"*)