Mercurial > urweb
diff src/mono_reduce.sml @ 1983:0ff4f64b4309
Merge in upstream
author | Patrick Hurst <phurst@mit.edu> |
---|---|
date | Wed, 29 Jan 2014 18:29:43 -0500 |
parents | fec7beec96c7 |
children | b15a4c2cb542 |
line wrap: on
line diff
--- a/src/mono_reduce.sml Sat Jan 25 18:15:14 2014 -0500 +++ b/src/mono_reduce.sml Wed Jan 29 18:29:43 2014 -0500 @@ -45,7 +45,7 @@ | TDatatype (n, _) => IS.member (tsyms, n) | _ => false) -fun simpleImpure (tsyms, syms) = +fun simpleImpure isGlobal (tsyms, syms) = U.Exp.existsB {typ = fn _ => false, exp = fn (env, e) => case e of @@ -65,6 +65,7 @@ in simpleTypeImpure tsyms t end + | EApp _ => not isGlobal | _ => false, bind = fn (env, b) => case b of @@ -325,7 +326,7 @@ case #1 e of ENamed n => IM.find (absCounts, n) | EApp (e, arg) => - if simpleImpure (timpures, impures) env arg then + if simpleImpure true (timpures, impures) env arg then NONE else (case remaining e of @@ -352,14 +353,14 @@ absCounts) | DVal (_, n, _, e, _) => (timpures, - if simpleImpure (timpures, impures) E.empty e then + if simpleImpure true (timpures, impures) E.empty e then IS.add (impures, n) else impures, IM.insert (absCounts, n, countAbs E.empty e)) | DValRec vis => (timpures, - if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then + if List.exists (fn (_, _, _, e, _) => simpleImpure true (timpures, impures) E.empty e) vis then foldl (fn ((_, n, _, _, _), impures) => IS.add (impures, n)) impures vis else @@ -532,7 +533,7 @@ end val impure = fn env => fn e => - simpleImpure (timpures, impures) env e andalso impure e + simpleImpure false (timpures, impures) env e andalso impure e andalso not (List.null (summarize ~1 e)) fun passive (e : exp) =