diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-11-27 12:43:28 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-27 12:43:28 -0500 |
| commit | 724eacaf90ae05aabe6950dc4295b7f3622e4996 (patch) | |
| tree | ee3ca9390d833115cec329bfd2c1c7bc7b13e5b6 | |
| parent | ac67d365ab2cef8de6b23eed69f275c338ff348d (diff) | |
Avoid Especializing polymorphic code
| -rw-r--r-- | src/core_util.sig | 5 | ||||
| -rw-r--r-- | src/core_util.sml | 24 | ||||
| -rw-r--r-- | src/especialize.sml | 12 |
3 files changed, 40 insertions, 1 deletions
diff --git a/src/core_util.sig b/src/core_util.sig index 39f50cc1..fc5a2bea 100644 --- a/src/core_util.sig +++ b/src/core_util.sig @@ -165,6 +165,11 @@ structure Decl : sig 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 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 diff --git a/src/especialize.sml b/src/especialize.sml index 335401fe..7abc0582 100644 --- a/src/especialize.sml +++ b/src/especialize.sml @@ -59,6 +59,12 @@ val freeVars = U.Exp.foldB {kind = fn (_, xs) => xs, | _ => 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 @@ fun specialize' file = (*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"*) |