From 8a2471f596ccc47a1037fe4418c287f13b491798 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 22 Sep 2009 17:12:20 -0400
Subject: demo/react works with interpretation

---
 lib/js/urweb.js | 52 ++++++++++++++++++++++++++++++++++++----------------
 src/jscomp.sml  |  6 +++---
 src/monoize.sml |  2 +-
 3 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index a1b4b1d2..d4c0f9b7 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -82,7 +82,7 @@ function runHandlers(kind, ls, arg) {
     alert(kind + ": " + arg);
   for (; ls; ls = ls.next)
     try {
-      ls.data(arg)(null);
+      exec({c:"a", f:{c:"a", f:ls.data, x:{c:"c", v:arg}}, x:{c:"c", v:null}});
     } catch (v) { }
 }
 
@@ -114,8 +114,12 @@ function doExn(v) {
 
 var disconnectHandlers = null;
 
+function flift(f) {
+  return {c:"l", b:f};
+}
+
 function onDisconnect(f) {
-  disconnectHandlers = cons(function (_){return f}, disconnectHandlers);
+  disconnectHandlers = cons(flift(f), disconnectHandlers);
 }
 
 function discon() {
@@ -125,7 +129,7 @@ function discon() {
 var connectHandlers = null;
 
 function onConnectFail(f) {
-  connectHandlers = cons(function (_){return f}, connectHandlers);
+  connectHandlers = cons(flift(f), connectHandlers);
 }
 
 function conn() {
@@ -207,12 +211,14 @@ function flattenLocal(s) {
 
 // Dynamic tree management
 
+var trace = "";
+
 function populate(node) {
   var s = node.signal;
   var oldSources = node.sources;
   try {
-    var sr = s();
-    var newSources = sr.sources;
+    var sr = exec0(s.env, s.body);
+    var newSources = sr._sources;
 
     for (var sp = oldSources; sp; sp = sp.next)
       if (!member(sp.data, newSources))
@@ -223,7 +229,7 @@ function populate(node) {
         sp.data.dyns = cons(node, sp.data.dyns);
 
     node.sources = newSources;
-    node.recreate(sr.data);
+    node.recreate(sr._data);
   } catch (v) {
     doExn(v);
   }
@@ -244,20 +250,28 @@ function sg(s) {
 }
 
 function ss(s) {
-  return function() { return {sources : cons(s, null), data : s.data } };
+  return {env:cons(s, null), body:{c:"r", l:
+    cons({n:"sources", v:{c:"c", v:cons(s, null)}},
+      cons({n:"data", v:{c:"f", f:sg, a:cons({c:"v", n:1}, null)}}, null))}};
 }
 function sr(v) {
-  return function() { return {sources : null, data : v } };
+  return {env:null, body:{c:"c", v:{_sources : null, _data : v}}};
 }
 function sb(x,y) {
-  return function() {
-    var xr = x();
-    var yr = y(xr.data)();
-    return {sources : union(xr.sources, yr.sources), data : yr.data};
-  };
+  return {env:cons(y,cons(x,null)),
+    body:{c:"=",
+      e1:{c:"a", f:{c:"v", n:1}, x:{c:"c", v:null}},
+      e2:{c:"=",
+        e1:{c:"a",
+          f:{c:"a", f:{c:"v", n:1}, x:{c:".", r:{c:"v", n:0}, f:"data"}},
+          x:{c:"c", v:null}},
+        e2:{c:"r", l:cons(
+          {n:"sources", v:{c:"f", f:union, a:cons({c:".", r:{c:"v", n:1}, f:"sources"},
+            cons({c:".", r:{c:"v", n:0}, f:"sources"}, null))}},
+          cons({n:"data", v:{c:".", r:{c:"v", n:0}, f:"data"}}, null))}}}};
 }
 function scur(s) {
-  return s().data;
+  return exec(s).data;
 }
 
 function lastParent() {
@@ -840,6 +854,9 @@ function exec0(env, e) {
   var stack = null;
 
   while (true) {
+    if (!e.c)
+      throw ("Trace: " + trace);
+    trace += "|" + e.c;
     switch (e.c) {
     case "c":
       var v = e.v;
@@ -863,7 +880,6 @@ function exec0(env, e) {
           stack = stack.next;
         } else {
           e = fr.a.data;
-          if (e == null) alert("Oh no!");
           fr.a = fr.a.next;
         }
         break;
@@ -907,9 +923,9 @@ function exec0(env, e) {
         stack = stack.next;
         break;
       case "=":
+        stack = cons({c: "a3", env: env}, stack.next);
         env = cons(v, env);
         e = fr.e2;
-        stack = cons({c: "a3", env: env}, stack.next);
         break;
       case "m":
         var ps;
@@ -996,6 +1012,10 @@ function exec0(env, e) {
   }
 }
 
+function execD(e) {
+  return exec0(null, e);
+}
+
 function exec(e) {
   var r = exec0(null, e);
 
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 570a708c..8e0297c3 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -882,11 +882,11 @@ fun process file =
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [str "{c:\"b\",e1:",
+                                (strcat [str "{c:\"f\",f:sb,a:cons(",
                                          e1,
-                                         str ",e2:",
+                                         str ",cons(",
                                          e2,
-                                         str "}"],
+                                         str ",null))}"],
                                  st)
                             end
                           | ESignalSource e =>
diff --git a/src/monoize.sml b/src/monoize.sml
index c0ae1fee..e0744cbe 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2682,7 +2682,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             [("Signal", e, _)] =>
                             ((L'.EStrcat
                                   ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
-                                                           ^ tag ^ "\", exec(")), loc),
+                                                           ^ tag ^ "\", execD(")), loc),
                                    (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
                                                 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
                              fm)
-- 
cgit v1.2.3