Redo signal implementation to avoid memory leaks

3 files changed, 77 insertions, 36 deletions

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index f4ed111b..d3c144b9 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1,41 +1,66 @@
 function cons(v, ls) {
-  return { n : ls, v : v };
+  return { next : ls, data : v };
 }
+function concat(ls1, ls2) {
+  return (ls1 ? cons(ls1.data, concat(ls1.next, ls2)) : ls2);
+}
+function member(x, ls) {
+  for (; ls; ls = ls.next)
+    if (ls.data == x)
+      return true;
+  return false;
+}
+function remove(x, ls) {
+  return (ls ? (ls.data == x ? ls.next : cons(ls.data, remove(x, ls.next))) : null);
+}
+function union(ls1, ls2) {
+  return (ls1 ? (member(ls1.data, ls2) ? union(ls1.next, ls2) : cons(ls1.data, union(ls1.next, ls2))) : ls2);
+}
+
+
+function populate(node) {
+  var s = node.signal;
+  var oldSources = node.sources;
+  var sr = s();
+  var newSources = sr.sources;
 
-function callAll(ls) {
-  for (; ls; ls = ls.n)
-    ls.v();
+  for (var sp = oldSources; sp; sp = sp.next)
+    if (!member(sp.data, newSources))
+      sp.data.dyns = remove(node, sp.data.dyns);
+
+  for (var sp = newSources; sp; sp = sp.next)
+    if (!member(sp.data, oldSources))
+      sp.data.dyns = cons(node, sp.data.dyns);
+
+  node.sources = newSources;
+  node.recreate(sr.data);
 }
 
 function sc(v) {
-  return {v : v, h : null};
+  return {data : v, dyns : null};
 }
 function sv(s, v) {
-  s.v = v;
-  callAll(s.h);
+  s.data = v;
+  for (var ls = s.dyns; ls; ls = ls.next)
+    if (!ls.dead)
+      populate(ls.data);
 }
 function sg(s) {
-  return s.v;
+  return s.data;
 }
 
 function ss(s) {
-  return s;
+  return function() { return {sources : cons(s, null), data : s.data } };
 }
 function sr(v) {
-  return {v : v, h : null};
+  return function() { return {sources : null, data : v } };
 }
 function sb(x,y) {
-  var z = y(x.v);
-  var s = {v : z.v, h : null};
-
-  function reZ() {
-    z.h = cons(function() { s.v = z.v; callAll(s.h); }, z.h);    
-  }
-
-  x.h = cons(function() { z = y(x.v); reZ(); s.v = z.v; callAll(s.h); }, x.h);
-  reZ();
-
-  return s;
+  return function() {
+    var xr = x();
+    var yr = y(xr.data)();
+    return {sources : union(xr.sources, yr.sources), data : yr.data};
+  };
 }
 
 function lastParent() {
@@ -47,8 +72,6 @@ function lastParent() {
   return pos.parentNode;
 }
 
-var thisScript = null;
-
 function addNode(node) {
   if (thisScript) {
     thisScript.parentNode.appendChild(node);
@@ -57,6 +80,8 @@ function addNode(node) {
     lastParent().appendChild(node);
 }
 
+var thisScript = null;
+
 function runScripts(node) {
   var savedScript = thisScript;
 
@@ -72,23 +97,36 @@ function runScripts(node) {
   thisScript = savedScript;
 }
 
-function populate(node, html) {
-  node.innerHTML = html;
-  runScripts(node);
-}
 
 function dyn(s) {
   var x = document.createElement("span");
-  populate(x, s.v);
+  x.dead = false;
+  x.signal = s;
+  x.sources = null;
+  x.recreate = function(v) {
+    var spans = x.getElementsByTagName("span");
+    for (var i = 0; i < spans.length; ++i) {
+      var span = spans[i];
+      span.dead = true;
+      for (var ls = span.sources; ls; ls = ls.next)
+        ls.data.dyns = remove(span, ls.data.dyns);
+    }
+
+    x.innerHTML = v;
+    runScripts(x);
+  };
+  populate(x);
   addNode(x);
-  s.h = cons(function() { populate(x, s.v) }, s.h);
 }
 
 function inp(t, s) {
   var x = document.createElement(t);
-  x.value = s.v;
+  x.dead = false;
+  x.signal = ss(s);
+  x.sources = null;
+  x.recreate = function(v) { if (x.value != v) x.value = v; };
+  populate(x);
   addNode(x);
-  s.h = cons(function() { if (x.value != s.v) x.value = s.v }, s.h);
   x.onkeyup = function() { sv(s, x.value) };
   return x;
 }
@@ -212,7 +250,7 @@ function enqueue(q, v) {
     q.back = q.front;
   } else {
     var node = cons(v, null);
-    q.back.n = node;
+    q.back.next = node;
     q.back = node;
   }
 }
@@ -220,8 +258,8 @@ function dequeue(q) {
   if (q.front == null)
     return null;
   else {
-    var r = q.front.v;
-    q.front = q.front.n;
+    var r = q.front.data;
+    q.front = q.front.next;
     if (q.front == null)
       q.back = null;
     return r;
@@ -257,7 +295,7 @@ function listener() {
       if (isok) {
         var lines = xhr.responseText.split("\n");
         if (lines.length < 2) 
-          return; //throw "Empty message from remote server";
+          return; // throw "Empty message from remote server";
 
         for (var i = 0; i+1 < lines.length; i += 2) {
           var chn = lines[i];
@@ -324,7 +362,7 @@ function rv(chn, parse, k) {
 }
 
 function uf(s) {
- return escape(s).replace(new RegExp ("/", "g"), "%2F");
+  return escape(s).replace(new RegExp ("/", "g"), "%2F");
 }
 
 function uu(s) {
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index b2f0ecee..505498b8 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -55,6 +55,7 @@ fun impure (e, _) =
       | EFfi _ => false
       | EFfiApp ("Basis", "set_cookie", _) => true
       | EFfiApp ("Basis", "new_client_source", _) => true
+      | EFfiApp ("Basis", "get_client_source", _) => true
       | EFfiApp ("Basis", "set_client_source", _) => true
       | EFfiApp ("Basis", "alert", _) => true
       | EFfiApp ("Basis", "new_channel", _) => true
@@ -274,6 +275,7 @@ fun reduce file =
                       | EFfi _ => []
                       | EFfiApp ("Basis", "set_cookie", es) => ffi es
                       | EFfiApp ("Basis", "new_client_source", es) => ffi es
+                      | EFfiApp ("Basis", "get_client_source", es) => ffi es
                       | EFfiApp ("Basis", "set_client_source", es) => ffi es
                       | EFfiApp ("Basis", "alert", es) => ffi es
                       | EFfiApp ("Basis", "new_channel", es) => ffi es
diff --git a/tests/chat.ur b/tests/chat.ur
index 8763a190..7f723ba5 100644
--- a/tests/chat.ur
+++ b/tests/chat.ur
@@ -48,6 +48,7 @@ fun chat id =
 
         fun doSpeak () =
             line <- get newLine;
+            set newLine "";
             speak line
     in
         return <xml><body onload={onload ()}>