# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1253646729 14400
# Node ID 8fe576c0bee97e201d3807e43d0328a865b1b146
# Parent  b851675a2c3dfef28bbb01fa90563a6bf1ba0d12
Quoting JavaScript working

diff -r b851675a2c3d -r 8fe576c0bee9 lib/js/urweb.js
--- a/lib/js/urweb.js	Tue Sep 22 14:15:29 2009 -0400
+++ b/lib/js/urweb.js	Tue Sep 22 15:12:09 2009 -0400
@@ -181,7 +181,7 @@
 }
 
 function cr(n) {
-  return closures[n]();
+  return closures[n];
 }
 
 function flatten(cls, tr) {
@@ -863,6 +863,7 @@
           stack = stack.next;
         } else {
           e = fr.a.data;
+          if (e == null) alert("Oh no!");
           fr.a = fr.a.next;
         }
         break;
@@ -983,9 +984,11 @@
       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 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 -r b851675a2c3d -r 8fe576c0bee9 src/mono_reduce.sml
--- a/src/mono_reduce.sml	Tue Sep 22 14:15:29 2009 -0400
+++ b/src/mono_reduce.sml	Tue Sep 22 15:12:09 2009 -0400
@@ -282,7 +282,18 @@
                              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 @@
                         ((*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 @@
                                         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 -r b851675a2c3d -r 8fe576c0bee9 tests/jscomp.ur
--- a/tests/jscomp.ur	Tue Sep 22 14:15:29 2009 -0400
+++ b/tests/jscomp.ur	Tue Sep 22 15:12:09 2009 -0400
@@ -6,12 +6,25 @@
         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 @@
       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 @@
       <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>