From 84bbd76f640d3e7718c090e229bb05d5f5e49eac Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 5 Apr 2009 16:17:32 -0400
Subject: Fixing some regressions and other bugs

---
 lib/js/urweb.js | 56 +++++++++++++++++++++++++++++++++++++++-----------------
 src/c/driver.c  |  3 +++
 src/jscomp.sml  |  8 ++++----
 3 files changed, 46 insertions(+), 21 deletions(-)

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index de956d3f..5ff5b9fb 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -18,6 +18,9 @@ function remove(x, ls) {
 function union(ls1, ls2) {
   return (ls1 ? (member(ls1.data, ls2) ? union(ls1.next, ls2) : cons(ls1.data, union(ls1.next, ls2))) : ls2);
 }
+function length(ls) {
+  return (ls ? 1 + length(ls.next) : 0);
+}
 
 
 // Embedding closures in XML strings
@@ -38,29 +41,40 @@ function cat(s1, s2) {
 }
 
 var closures = [];
+var freeClosures = null;
 
 function newClosure(f) {
-  var n = closures.length;
+  var n;
+  if (freeClosures == null) {
+    n = closures.length;
+  } else {
+    n = freeClosures.data;
+    freeClosures = freeClosures.next;
+  }
   closures[n] = f;
   return n;
 }
 
+function freeClosure(n) {
+  closures[n] = null;
+  freeClosures = cons(n, freeClosures);
+}
+
 function cr(n) {
   return closures[n]();
 }
 
-function flatten(tr) {
+function flatten(cls, tr) {
   if (tr.cat1 != null)
-    return flatten(tr.cat1) + flatten(tr.cat2);
-  else if (tr.closure != null)
-    return "cr(" + newClosure(tr.closure) + ")";
-  else
+    return flatten(cls, tr.cat1) + flatten(cls, tr.cat2);
+  else if (tr.closure != null) {
+    var cl = newClosure(tr.closure);
+    cls.v = cons(cl, cls.v);
+    return "cr(" + cl + ")";
+  } else
     return tr;
 }
 
-function clearClosures() {
-  closures = [];
-}
 
 
 // Dynamic tree management
@@ -154,8 +168,10 @@ function dyn(s) {
   x.dead = false;
   x.signal = s;
   x.sources = null;
+  x.closures = null;
   x.recreate = function(v) {
-    ++dynDepth;
+    for (var ls = x.closures; ls; ls = ls.next)
+      freeClosure(ls.data);
 
     var spans = x.getElementsByTagName("span");
     for (var i = 0; i < spans.length; ++i) {
@@ -163,16 +179,17 @@ function dyn(s) {
       span.dead = true;
       for (var ls = span.sources; ls; ls = ls.next)
         ls.data.dyns = remove(span, ls.data.dyns);
+      for (var ls = span.closures; ls; ls = ls.next)
+        freeClosure(ls.data);
     }
 
-    x.innerHTML = flatten(v);
+    var cls = {v : null};
+    x.innerHTML = flatten(cls, v);
+    x.closures = cls.v;
     runScripts(x);
-
-    if (--dynDepth == 0)
-      clearClosures();
   };
-  populate(x);
   addNode(x);
+  populate(x);
 }
 
 function inp(t, s) {
@@ -236,7 +253,7 @@ function pf() {
 
 // Remote calls
 
-var client_id = 0;
+var client_id = null;
 var client_pass = 0;
 var url_prefix = "/";
 var timeout = 60;
@@ -261,7 +278,7 @@ function getXHR(uri)
 function requestUri(xhr, uri) {
   xhr.open("GET", uri, true);
 
-  if (client_id != 0) {
+  if (client_id != null) {
     xhr.setRequestHeader("UrWeb-Client", client_id.toString());
     xhr.setRequestHeader("UrWeb-Pass", client_pass.toString());
   }
@@ -270,6 +287,11 @@ function requestUri(xhr, uri) {
 }
 
 function rc(uri, parse, k) {
+  var cls = {v : null};
+  uri = flatten(cls, uri);
+  for (cl = cls.v; cl != null; cl = cl.next)
+    freeClosure(cl.data);
+
   var xhr = getXHR();
 
   xhr.onreadystatechange = function() {
diff --git a/src/c/driver.c b/src/c/driver.c
index c5e1ba33..712de2de 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -182,6 +182,9 @@ static void *worker(void *data) {
             dont_close = 1;
             fprintf(stderr, "Processed request for messages by client %u\n\n", idn);
           }
+          else {
+            fprintf(stderr, "Missing fields in .msgs request: %s, %s\n\n", id, pass);
+          }
           break;
         }
 
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 9cefc60f..9a621906 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -364,7 +364,7 @@ fun process file =
                             else
                                 e
                 in
-                    ("(uu=t[i++],uu==\"Some\"?" ^ e ^ ":null)", st)
+                    ("(t[i++]==\"Some\"?" ^ e ^ ":null)", st)
                 end
 
               | TDatatype (n, ref (dk, cs)) =>
@@ -861,7 +861,7 @@ fun process file =
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str "alert(\"ERROR: \"+", e, str ")"],
+                                (strcat [str "alert(cat(\"ERROR: \",", e, str "))"],
                                  st)
                             end
 
@@ -952,9 +952,9 @@ fun process file =
                                 val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
-                                (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ "\"+"),
+                                (strcat [str ("rc(cat(\"" ^ !Monoize.urlPrefix ^ "\","),
                                          e,
-                                         str (", function(s){var t=s.split(\"/\");var i=0;return "
+                                         str ("), function(s){var t=s.split(\"/\");var i=0;return "
                                               ^ unurl ^ "},"),
                                          ek,
                                          str ")"],
-- 
cgit v1.2.3