diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-01-12 20:37:39 -0500 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-01-12 20:37:39 -0500 |
commit | a3f5a3a95ee01e9d27933ca5c1c755ceb9dac1af (patch) | |
tree | 4345b88e3ae93a675e27dffbe3a5b9a44499a74b /src/especialize.sml | |
parent | 7f9f5b2409507d7b84f15737be1f4ce185e4cda6 (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.sml | 28 |
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) |