diff options
| -rw-r--r-- | lib/js/urweb.js | 13 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 18 | ||||
| -rw-r--r-- | tests/jscomp.ur | 24 |
3 files changed, 46 insertions, 9 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 13f93867..a1b4b1d2 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -181,7 +181,7 @@ function freeClosure(n) { } function cr(n) { - return closures[n](); + return closures[n]; } function flatten(cls, tr) { @@ -863,6 +863,7 @@ function exec0(env, e) { stack = stack.next; } else { e = fr.a.data; + if (e == null) alert("Oh no!"); fr.a = fr.a.next; } break; @@ -983,9 +984,11 @@ function exec0(env, e) { e = e.e; break; case "e": - var env0 = env; - var e0 = e.e; - e = {c: "c", v: cs(function() { return exec0(env0, e0); })}; + e = {c: "c", v: cs({c: "wc", env: env, body: e.e})}; + break; + case "wc": + env = e.env; + e = e.body; break; default: throw ("Unknown Ur expression kind " + e.c); @@ -996,7 +999,7 @@ function exec0(env, e) { function exec(e) { var r = exec0(null, e); - if (r != null && r.body) + if (r != null && r.body != null) return function(v) { return exec0(cons(v, r.env), r.body); }; else return r; diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 5904ce65..07e54b4d 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -282,7 +282,18 @@ val countFree = U.Exp.foldB {typ = fn (_, n) => n, bind = fn (n, b) => case b of U.Exp.RelE _ => n + 1 - | _ => n} 0 0 + | _ => n} + +val freeInAbs = U.Exp.existsB {typ = fn _ => false, + exp = fn (n, e) => + case e of + EAbs (_, _, _, b) => countFree n 0 b > 0 + | EJavaScript (_, b) => countFree n 0 b > 0 + | _ => false, + bind = fn (n, b) => + case b of + U.Exp.RelE _ => n + 1 + | _ => n} 0 fun reduce file = let @@ -457,7 +468,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 orelse countFree e1 > 1 then + if impure env e2 orelse countFree 0 0 e1 > 1 then #1 (reduceExp env (ELet (x, t, e2, e1), loc)) else #1 (reduceExp env (subExpInExp (0, e2) e1))) @@ -608,7 +619,8 @@ fun reduce file = orelse (case effs_b of UseRel :: effs => List.all verifyUnused effs | _ => false)) - andalso countFree b = 1 then + andalso countFree 0 0 b = 1 + andalso not (freeInAbs b) then trySub () else e diff --git a/tests/jscomp.ur b/tests/jscomp.ur index 1d5e3b54..e2cf4f94 100644 --- a/tests/jscomp.ur +++ b/tests/jscomp.ur @@ -6,12 +6,25 @@ fun fact n = 0 => 1 | _ => n * fact (n - 1) +datatype t = + A + | B of {C : int, D : float} + | E of t * t + +fun render x = + case x of + A => "A" + | B {C = n1, D = n2} => "B(" ^ show n1 ^ "," ^ show n2 ^ ")" + | E (x, y) => "C(" ^ render x ^ "," ^ render y ^ ")" + fun main () = s <- source ""; s' <- source ""; f <- source (plus 1); f2 <- source fst; r <- source {A = "x", B = "y"}; + t <- source (E (A, B {C = 10, D = 1.23})); + ht <- source <xml>Nothing here yet.</xml>; return <xml><body> <ctextbox source={s}/> <ctextbox source={s'}/><br/><br/> @@ -22,7 +35,10 @@ fun main () = Function2: <button value="Fst" onclick={set f2 fst}/> <button value="Snd" onclick={set f2 snd}/><br/><br/> + Both: <button value="*3,Snd" onclick={set f (times 3); set f2 snd}/><br/><br/> + <button value="Echo" onclick={s <- get s; alert s}/> + <button value="Echo2" onclick={s <- get s; alert s; alert s}/> <button value="-" onclick={s <- get s; alert (show (-(readError s : int)))}/> <button value="+1" onclick={s <- get s; alert (show (readError s + 1))}/> <button value="*3" onclick={s <- get s; alert (show ((readError s) * 3))}/> @@ -35,5 +51,11 @@ fun main () = <button value="f2" onclick={s <- get s; s' <- get s'; f2 <- get f2; alert (f2 s s')}/><br/><br/> <button value="A" onclick={r <- get r; alert r.A}/> - <button value="B" onclick={r <- get r; alert r.B}/> + <button value="B" onclick={r <- get r; alert r.B}/><br/><br/> + + <button value="render" onclick={t <- get t; alert (render t)}/><br/><br/> + + <dyn signal={signal ht}/> + <button value="Set" onclick={s <- get s; + set ht <xml><button value="Dynamic!" onclick={alert s}/></xml>}/> </body></xml> |