Mercurial > urweb
changeset 948:b03d48aac959
Find more opportunities for 'let' inlining with better purity information
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 17 Sep 2009 12:55:22 -0400 |
| parents | e2305dcc3965 |
| children | 6646b95f1860 |
| files | src/mono_reduce.sml |
| diffstat | 1 files changed, 34 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/src/mono_reduce.sml Thu Sep 17 09:25:03 2009 -0400 +++ b/src/mono_reduce.sml Thu Sep 17 12:55:22 2009 -0400 @@ -38,12 +38,12 @@ structure IS = IntBinarySet -val simpleTypeImpure = +fun simpleTypeImpure tsyms = U.Typ.exists (fn TFun _ => true - | TDatatype _ => true + | TDatatype (n, _) => IS.member (tsyms, n) | _ => false) -fun simpleImpure syms = +fun simpleImpure (tsyms, syms) = U.Exp.existsB {typ = fn _ => false, exp = fn (env, e) => case e of @@ -51,7 +51,6 @@ | EQuery _ => true | EDml _ => true | ENextval _ => true - | EUnurlify _ => true | EFfiApp (m, x, _) => Settings.isEffectful (m, x) | EServerCall _ => true | ERecv _ => true @@ -61,7 +60,7 @@ let val (_, t, _) = E.lookupERel env n in - simpleTypeImpure t + simpleTypeImpure tsyms t end | _ => false, bind = fn (env, b) => @@ -287,8 +286,8 @@ fun reduce file = let - val (impures, absCounts) = - foldl (fn ((d, _), (impures, absCounts)) => + val (timpures, impures, absCounts) = + foldl (fn ((d, _), (timpures, impures, absCounts)) => let fun countAbs (e, _) = case e of @@ -296,14 +295,26 @@ | _ => 0 in case d of - DVal (_, n, _, e, _) => - (if simpleImpure impures E.empty e then + DDatatype dts => + (if List.exists (fn (_, _, cs) => + List.exists (fn (_, _, NONE) => false + | (_, _, SOME t) => simpleTypeImpure timpures t) cs) + dts then + IS.addList (timpures, map #2 dts) + else + timpures, + impures, + absCounts) + | DVal (_, n, _, e, _) => + (timpures, + if simpleImpure (timpures, impures) E.empty e then IS.add (impures, n) else impures, IM.insert (absCounts, n, countAbs e)) | DValRec vis => - (if List.exists (fn (_, _, _, e, _) => simpleImpure impures E.empty e) vis then + (timpures, + if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then foldl (fn ((_, n, _, _, _), impures) => IS.add (impures, n)) impures vis else @@ -311,9 +322,9 @@ foldl (fn ((x, n, _, e, _), absCounts) => IM.insert (absCounts, n, countAbs e)) absCounts vis) - | _ => (impures, absCounts) + | _ => (timpures, impures, absCounts) end) - (IS.empty, IM.empty) file + (IS.empty, IS.empty, IM.empty) file fun summarize d (e, _) = let @@ -341,13 +352,16 @@ let val ls = rev ls in - case IM.find (absCounts, n) of - NONE => [Unsure] - | SOME len => - if passed < len then - ls - else - ls @ [Unsure] + if IS.member (impures, n) then + case IM.find (absCounts, n) of + NONE => [Unsure] + | SOME len => + if passed < len then + ls + else + ls @ [Unsure] + else + ls end | ERel n => List.revAppend (ls, if n = d then @@ -419,7 +433,7 @@ end val impure = fn env => fn e => - simpleImpure impures env e andalso impure e + simpleImpure (timpures, impures) env e andalso impure e andalso not (List.null (summarize ~1 e)) fun exp env e =