# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1252862709 14400
# Node ID 0a156bbd205f5f7cba1487a30e2165952593efbd
# Parent  be6585b4058b84839b14ac68e6212b615c0be099
Full Grid1 compiles, thanks to avoiding code size blow-up in mono_reduce

diff -r be6585b4058b -r 0a156bbd205f demo/more/grid1.ur
--- a/demo/more/grid1.ur	Sun Sep 13 12:00:34 2009 -0400
+++ b/demo/more/grid1.ur	Sun Sep 13 13:25:09 2009 -0400
@@ -8,7 +8,7 @@
   PRIMARY KEY Id,
   CONSTRAINT Foreign FOREIGN KEY (D) REFERENCES t1(Id) ON DELETE CASCADE
 
-(*fun page (n, s) = return <xml>A = {[n]}, B = {[s]}</xml>*)
+fun page (n, s) = return <xml>A = {[n]}, B = {[s]}</xml>
 
 open Make(struct
               val tab = t
@@ -36,14 +36,14 @@
                                            end)
 
               val cols = {Id = Direct.readOnly [#Id] ! "Id" Direct.int,
-                          (*A = Direct.editable [#A] ! "A" Direct.int,
+                          A = Direct.editable [#A] ! "A" Direct.int,
                           B = Direct.editable [#B] ! "B" Direct.string,
                           C = Direct.editable [#C] ! "C" Direct.bool,
-                          D = Direct.editable [#D] ! "D" F.meta,*)
+                          D = Direct.editable [#D] ! "D" F.meta,
                           E = Direct.editable [#E] ! "E" (Direct.nullable Direct.int),
-                          F = Direct.editable [#F] ! "F" (Direct.nullable F.meta)(*,
+                          F = Direct.editable [#F] ! "F" (Direct.nullable F.meta),
                           DA = computed "2A" (fn r => 2 * r.A),
-                          Link = computedHtml "Link" (fn r => <xml><a link={page (r.A, r.B)}>Go</a></xml>)*)}
+                          Link = computedHtml "Link" (fn r => <xml><a link={page (r.A, r.B)}>Go</a></xml>)}
           end)
 
 fun main () =
diff -r be6585b4058b -r 0a156bbd205f src/mono_reduce.sml
--- a/src/mono_reduce.sml	Sun Sep 13 12:00:34 2009 -0400
+++ b/src/mono_reduce.sml	Sun Sep 13 13:25:09 2009 -0400
@@ -275,6 +275,16 @@
       | 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 @@
                         ((*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 @@
                                     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