Fix overzealous Marshalcheck; garbage-collect string-embedded closures when no dyns are active

5 files changed, 79 insertions, 38 deletions

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 4a447a5b..fe996833 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1,3 +1,5 @@
+// Lists
+
 function cons(v, ls) {
   return { next : ls, data : v };
 }
@@ -18,6 +20,43 @@ function union(ls1, ls2) {
 }
 
 
+// Embedding closures in XML strings
+
+function cat(s1, s2) {
+  if (s1.length && s2.length)
+    return s1 + s2;
+  else
+    return {_1: s1, _2: s2};
+}
+
+var closures = [];
+
+function newClosure(f) {
+  var n = closures.length;
+  closures[n] = f;
+  return n;
+}
+
+function cr(n) {
+  return closures[n]();
+}
+
+function flatten(tr) {
+  if (tr.length)
+    return tr;
+  else if (tr._1)
+    return cs(tr._1) + cs(tr._2);
+  else
+    return "cr(" + newClosure(tr) + ")";
+}
+
+function clearClosures() {
+  closures = [];
+}
+
+
+// Dynamic tree management
+
 function populate(node) {
   var s = node.signal;
   var oldSources = node.sources;
@@ -85,7 +124,7 @@ var thisScript = null;
 function runScripts(node) {
   var savedScript = thisScript;
 
-  var scripts = node.getElementsByTagName("script"), scriptsCopy = {};
+  var scripts = node.getElementsByTagName("script"), scriptsCopy = [];
   var len = scripts.length;
   for (var i = 0; i < len; ++i)
     scriptsCopy[i] = scripts[i];
@@ -98,12 +137,18 @@ function runScripts(node) {
 }
 
 
+// Dynamic tree entry points
+
+var dynDepth = 0;
+
 function dyn(s) {
   var x = document.createElement("span");
   x.dead = false;
   x.signal = s;
   x.sources = null;
   x.recreate = function(v) {
+    ++dynDepth;
+
     var spans = x.getElementsByTagName("span");
     for (var i = 0; i < spans.length; ++i) {
       var span = spans[i];
@@ -114,6 +159,9 @@ function dyn(s) {
 
     x.innerHTML = v;
     runScripts(x);
+
+    if (--dynDepth == 0)
+      clearClosures();
   };
   populate(x);
   addNode(x);
@@ -131,6 +179,9 @@ function inp(t, s) {
   return x;
 }
 
+
+// Basic string operations
+
 function eh(x) {
   return x.split("&").join("&amp;").split("<").join("&lt;").split(">").join("&gt;");
 }
@@ -154,10 +205,17 @@ function pfl(s) {
     throw "Can't parse float: " + s;
 }
 
-function cat(s1, s2) {
-  return s1 + s2;
+function uf(s) {
+  return escape(s).replace(new RegExp ("/", "g"), "%2F");
 }
 
+function uu(s) {
+  return unescape(s).replace(new RegExp ("\\+", "g"), " ");
+}
+
+
+// Error handling
+
 function whine(msg) {
   alert(msg);
   throw msg;
@@ -167,18 +225,8 @@ function pf() {
   whine("Pattern match failure");
 }
 
-var closures = [];
-
-function ca(f) {
-  var n = closures.length;
-  closures[n] = f;
-  return n;
-}
-
-function cr(n) {
-  return closures[n]();
-}
 
+// Remote calls
 
 var client_id = 0;
 var client_pass = 0;
@@ -364,11 +412,3 @@ function rv(chn, parse, k) {
     k(parse(msg))(null);
   }
 }
-
-function uf(s) {
-  return escape(s).replace(new RegExp ("/", "g"), "%2F");
-}
-
-function uu(s) {
-  return unescape(s).replace(new RegExp ("\\+", "g"), " ");
-}
diff --git a/src/compiler.sig b/src/compiler.sig
index d932c906..94dac67a 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -69,10 +69,10 @@ signature COMPILER = sig
     val shake : (Core.file, Core.file) phase
     val rpcify : (Core.file, Core.file) phase
     val tag : (Core.file, Core.file) phase
-    val marshalcheck : (Core.file, Core.file) phase
     val reduce : (Core.file, Core.file) phase
     val unpoly : (Core.file, Core.file) phase
     val specialize : (Core.file, Core.file) phase
+    val marshalcheck : (Core.file, Core.file) phase
     val monoize : (Core.file, Mono.file) phase
     val mono_opt : (Mono.file, Mono.file) phase
     val untangle : (Mono.file, Mono.file) phase
@@ -100,11 +100,11 @@ signature COMPILER = sig
     val toCore_untangle2 : (string, Core.file) transform
     val toShake2 : (string, Core.file) transform
     val toTag : (string, Core.file) transform
-    val toMarshalcheck : (string, Core.file) transform
     val toReduce : (string, Core.file) transform
     val toUnpoly : (string, Core.file) transform 
     val toSpecialize : (string, Core.file) transform 
     val toShake3 : (string, Core.file) transform
+    val toMarshalcheck : (string, Core.file) transform
     val toMonoize : (string, Mono.file) transform
     val toMono_opt1 : (string, Mono.file) transform
     val toUntangle : (string, Mono.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index 0eb8cb0f..6a43d94e 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -475,19 +475,12 @@ val tag = {
 
 val toTag = transform tag "tag" o toCore_untangle2
 
-val marshalcheck = {
-    func = (fn file => (MarshalCheck.check file; file)),
-    print = CorePrint.p_file CoreEnv.empty
-}
-
-val toMarshalcheck = transform marshalcheck "marshalcheck" o toTag
-
 val reduce = {
     func = Reduce.reduce,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toReduce = transform reduce "reduce" o toMarshalcheck
+val toReduce = transform reduce "reduce" o toTag
 
 val unpoly = {
     func = Unpoly.unpoly,
@@ -505,12 +498,19 @@ val toSpecialize = transform specialize "specialize" o toUnpoly
 
 val toShake3 = transform shake "shake3" o toSpecialize
 
+val marshalcheck = {
+    func = (fn file => (MarshalCheck.check file; file)),
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake3
+
 val monoize = {
     func = Monoize.monoize CoreEnv.empty,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMonoize = transform monoize "monoize" o toShake3
+val toMonoize = transform monoize "monoize" o toMarshalcheck
 
 val mono_opt = {
     func = MonoOpt.optimize,
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 934b9945..1409a0cb 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -891,9 +891,9 @@ fun process file =
 
                           | EJavaScript (Source _, _, SOME _) => (e, st)
                           | EJavaScript (_, _, SOME e) =>
-                            (strcat [str "\"cr(\"+ca(function(){return ",
+                            (strcat [str "function(){return ",
                                      e,
-                                     str "})+\")\""],
+                                     str "}"],
                              st)
 
                           | EClosure _ => unsupported "EClosure"
@@ -905,9 +905,9 @@ fun process file =
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str "\"cr(\"+ca(function(){return ",
+                                (strcat [str "function(){return ",
                                          e,
-                                         str "})+\")\""],
+                                         str "}"],
                                  st)
                             end
 
diff --git a/src/marshalcheck.sml b/src/marshalcheck.sml
index 2cce607b..c48fd14f 100644
--- a/src/marshalcheck.sml
+++ b/src/marshalcheck.sml
@@ -58,7 +58,8 @@ val clientToServer = [("Basis", "int"),
                       ("Basis", "string"),
                       ("Basis", "time"),
                       ("Basis", "unit"),
-                      ("Basis", "option")]
+                      ("Basis", "option"),
+                      ("Basis", "bool")]
 
 val clientToServer = PS.addList (PS.empty, clientToServer)