summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-27 12:43:28 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-27 12:43:28 -0500
commit724eacaf90ae05aabe6950dc4295b7f3622e4996 (patch)
treeee3ca9390d833115cec329bfd2c1c7bc7b13e5b6 /src
parentac67d365ab2cef8de6b23eed69f275c338ff348d (diff)
Avoid Especializing polymorphic code
Diffstat (limited to 'src')
-rw-r--r--src/core_util.sig5
-rw-r--r--src/core_util.sml24
-rw-r--r--src/especialize.sml12
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"*)