summaryrefslogtreecommitdiff
path: root/src/especialize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-01-12 20:37:39 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2012-01-12 20:37:39 -0500
commita3f5a3a95ee01e9d27933ca5c1c755ceb9dac1af (patch)
tree4345b88e3ae93a675e27dffbe3a5b9a44499a74b /src/especialize.sml
parent7f9f5b2409507d7b84f15737be1f4ce185e4cda6 (diff)
-dumpSource flag; Especialize tweak: may specialize any argument sequence ending in a value of function-containing type
Diffstat (limited to 'src/especialize.sml')
-rw-r--r--src/especialize.sml28
1 files changed, 14 insertions, 14 deletions
diff --git a/src/especialize.sml b/src/especialize.sml
index a73d4064..fb1dfecd 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -210,13 +210,8 @@ fun calcConstArgs enclosingFunction e =
case #1 e of
EAbs (_, _, _, e1) => enterAbs (depth + 1) e1
| _ => ca depth e
-
- val n = enterAbs 0 e
in
- if n = maxInt then
- 0
- else
- n
+ enterAbs 0 e
end
@@ -373,18 +368,23 @@ fun specialize' (funcs, specialized) file =
val loc = ErrorMsg.dummySpan
+ val oldXs = xs
+
fun findSplit av (constArgs, xs, typ, fxs, fvs) =
case (#1 typ, xs) of
(TFun (dom, ran), e :: xs') =>
if constArgs > 0 then
- findSplit av (constArgs - 1,
- xs',
- ran,
- e :: fxs,
- IS.union (fvs, freeVars e))
+ if functionInside dom then
+ (rev (e :: fxs), xs', IS.union (fvs, freeVars e))
+ else
+ findSplit av (constArgs - 1,
+ xs',
+ ran,
+ e :: fxs,
+ IS.union (fvs, freeVars e))
else
- (rev fxs, xs, fvs)
- | _ => (rev fxs, xs, fvs)
+ ([], oldXs, IS.empty)
+ | _ => ([], oldXs, IS.empty)
val (fxs, xs, fvs) = findSplit true (constArgs, xs, typ, [], IS.empty)