Mercurial > urweb
changeset 932:0a156bbd205f
Full Grid1 compiles, thanks to avoiding code size blow-up in mono_reduce
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 13 Sep 2009 13:25:09 -0400 |
| parents | be6585b4058b |
| children | 6a284a3519ba |
| files | demo/more/grid1.ur src/mono_reduce.sml |
| diffstat | 2 files changed, 18 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- 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 () =
--- 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