diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-09-13 13:25:09 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-13 13:25:09 -0400 |
| commit | 3e58952b52b3a731a8e78b11b47f0e8d6e647d14 (patch) | |
| tree | df54e06c4519ae222dd00aeb0e1cbbf26007e4a9 /src/mono_reduce.sml | |
| parent | 3120f9ddb17494dc36d7a329c28dc587be55de77 (diff) | |
Full Grid1 compiles, thanks to avoiding code size blow-up in mono_reduce
Diffstat (limited to 'src/mono_reduce.sml')
| -rw-r--r-- | src/mono_reduce.sml | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index c552db17..171bcef0 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -275,6 +275,16 @@ fun patBinds (p, _) = | PNone _ => 0 | PSome (_, p) => patBinds p +val countFree = U.Exp.foldB {typ = fn (_, n) => n, + exp = fn (x, e, n) => + case e of + ERel x' => if x = x' then n + 1 else n + | _ => n, + bind = fn (n, b) => + case b of + U.Exp.RelE _ => n + 1 + | _ => n} 0 0 + fun reduce file = let val (impures, absCounts) = @@ -434,7 +444,7 @@ fun reduce file = ((*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 then + if impure env e2 orelse countFree e1 > 1 then #1 (reduceExp env (ELet (x, t, e2, e1), loc)) else #1 (reduceExp env (subExpInExp (0, e2) e1))) @@ -522,8 +532,8 @@ fun reduce file = val r = subExpInExp (0, e') b in (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'), - ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), - ("r", MonoPrint.p_exp env r)];*) + ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), + ("r", MonoPrint.p_exp env r)];*) #1 (reduceExp env r) end |