Mercurial > urweb
diff src/mono_reduce.sml @ 1852:3c93e91e97da
Get Iflow working again
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 21 Apr 2013 13:03:20 -0400 |
parents | e15234fbb163 |
children | bddd0ec5d3da |
line wrap: on
line diff
--- a/src/mono_reduce.sml Sun Apr 21 10:29:30 2013 -0400 +++ b/src/mono_reduce.sml Sun Apr 21 13:03:20 2013 -0400 @@ -31,6 +31,8 @@ open Mono +val fullMode = ref false + structure E = MonoEnv structure U = MonoUtil @@ -531,27 +533,27 @@ simpleImpure (timpures, impures) env e andalso impure e andalso not (List.null (summarize ~1 e)) + 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 exp env e = let (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*) fun doLet (x, t, e', b) = let - 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 val r = subExpInExp (0, e') b @@ -630,7 +632,7 @@ else e end - else if countFree 0 0 b > 1 andalso not (passive e') then + else if countFree 0 0 b > 1 andalso not (!fullMode) andalso not (passive e') then e else trySub () @@ -653,7 +655,7 @@ ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1), ("e2", MonoPrint.p_exp env e2), ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*) - if impure env e2 orelse countFree 0 0 e1 > 1 then + if impure env e2 orelse (not (!fullMode) andalso countFree 0 0 e1 > 1) then #1 (reduceExp env (ELet (x, t, e2, e1), loc)) else #1 (reduceExp env (subExpInExp (0, e2) e1)))