Mercurial > urweb
changeset 1824:216e92b39fc1
Paranoid inlining prevention for FFI types at the Core level; less paranoid inlining promotion for passive values at the Mono level
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Wed, 19 Sep 2012 18:01:22 -0400 |
| parents | 66a58d8501e0 |
| children | 52c291b05738 |
| files | src/mono_reduce.sml src/reduce.sml |
| diffstat | 2 files changed, 21 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/src/mono_reduce.sml Wed Sep 19 14:36:12 2012 -0400 +++ b/src/mono_reduce.sml Wed Sep 19 18:01:22 2012 -0400 @@ -537,16 +537,20 @@ fun doLet (x, t, e', b) = let - val notValue = U.Exp.exists {typ = fn _ => false, - exp = fn e => - case e of - EPrim _ => false - | ECon _ => false - | ENone _ => false - | ESome _ => false - | ERecord _ => false - | _ => true} - + fun passive (e : exp) = + case #1 e of + EPrim _ => true + | ERel _ => true + | ENamed _ => true + | ECon (_, _, NONE) => true + | ECon (_, _, SOME e) => passive e + | ENone _ => true + | ESome (_, e) => passive e + | EFfi _ => true + | EAbs _ => true + | ERecord xets => List.all (passive o #2) xets + | EField (e, _) => passive e + | _ => false fun doSub () = let @@ -626,7 +630,7 @@ else e end - else if countFree 0 0 b > 1 andalso notValue e' then + else if countFree 0 0 b > 1 andalso not (passive e') then e else trySub ()
--- a/src/reduce.sml Wed Sep 19 14:36:12 2012 -0400 +++ b/src/reduce.sml Wed Sep 19 18:01:22 2012 -0400 @@ -247,6 +247,11 @@ | EField (e, _, _) => passive e | _ => false +fun notFfi (t : con) = + case #1 t of + CFfi _ => false + | _ => true + fun kindConAndExp (namedC, namedE) = let fun kind env (all as (k, loc)) = @@ -793,7 +798,7 @@ val t = con env t in - if passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t then + if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t) then exp (KnownE e1 :: env) e2 else (ELet (x, t, e1', exp (UnknownE :: env) e2), loc)