From cd9a791612f456a9ba679b6848cf58f81665ac10 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 22 Sep 2009 12:23:21 -0400
Subject: Hopefully complete refactoring of Jscomp to output ASTs; partial
 implementation of interpreter in runtime system (demo/alert works)

---
 lib/js/urweb.js | 186 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 184 insertions(+), 2 deletions(-)

(limited to 'lib')

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index a952c049..abdf2ab7 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1,3 +1,17 @@
+// Function versions of operators
+
+function not(x) { return !x; }
+function neg(x) { return -x; }
+
+function eq(x, y) { return x == y; }
+function plus(x, y) { return x + y; }
+function minus(x, y) { return x - y; }
+function times(x, y) { return x * y; }
+function div(x, y) { return x / y; }
+function mod(x, y) { return x % y; }
+function lt(x, y) { return x < y; }
+function le(x, y) { return x <= y; }
+
 // Lists
 
 function cons(v, ls) {
@@ -765,8 +779,176 @@ function rv(chn, parse, k) {
 
 // Key events
 
-function kc(e) {
-  return window.event ? e.keyCode : e.which;
+var uw_event = null;
+
+function kc() {
+  return window.event ? uw_event.keyCode : uw_event.which;
+}
+
+
+// The Ur interpreter
+
+var urfuncs = [];
+
+function lookup(env, n) {
+  while (env != null) {
+    if (n == 0)
+      return env.data;
+    else {
+      --n;
+      env = env.next;
+    }
+  }
+
+  throw "Out-of-bounds Ur variable reference";
+}
+
+function exec0(env, e) {
+  var stack = null;
+
+  while (true) {
+    switch (e.c) {
+    case "c":
+      var v = e.v;
+      if (stack == null)
+        return v;
+      var fr = stack.data;
+
+      switch (fr.c) {
+      case "s":
+        e = {c: "c", v: {v: v}};
+        stack = stack.next;
+        break;
+      case "1":
+        e = {c: "c", v: {n: fr.n, v: v}};
+        stack = stack.next;
+        break;
+      case "f":
+        fr.args[fr.pos++] = v;
+        if (fr.a == null) {
+          e = {c: "c", v: fr.f.apply(null, fr.args)};
+          stack = stack.next;
+        } else {
+          e = fr.a.data;
+          fr.a = fr.a.next;
+        }
+        break;
+      case "a1":
+        if (v == null || !v.body)
+          throw "Ur: applying non-function";
+        stack = cons({c: "a2", env: v.env, body: v.body}, stack.next);
+        e = fr.x;
+        break;
+      case "a2":
+        stack = cons({c: "a3", env: env}, stack.next);
+        env = cons(v, fr.env);
+        e = fr.body;
+        break;
+      case "a3":
+        env = fr.env;
+        stack = stack.next;
+        break;
+      case "r":
+        fr.fs["_" + fr.n] = v;
+        if (fr.l == null) {
+          e = {c: "c", v: fr.fs};
+          stack = stack.next;
+        } else {
+          fr.n = fr.l.data.n;
+          e = fr.l.data.v;
+          fr.l = fr.l.next;
+        }
+        break;
+      case ".":
+        e = {c: "c", v: v["_" + fr.f]};
+        stack = stack.next;
+        break;
+      case ";":
+        e = fr.e2;
+        stack = stack.next;
+        break;
+      case "=1":
+        env = cons(v, env);
+        e = fr.e2;
+        stack = stack.next;
+        break;
+      case "=":
+        env = cons(v, env);
+        e = fr.e2;
+        stack = cons({c: "a3", env: env}, stack.next);
+        break;
+      default:
+        throw "Unknown Ur continuation kind";
+      }
+
+      break;
+    case "v":
+      e = {c: "c", v: lookup(env, e.n)};
+      break;
+    case "n":
+      e = {c: "c", v: urfuncs[e.n]};
+      break;
+    case "s":
+      stack = cons({c: "s"}, stack);
+      e = e.v;
+      break;
+    case "1":
+      stack = cons({c: "1", n: e.n}, stack);
+      e = e.v;
+      break;
+    case "f":
+      if (e.a == null)
+        e = {c: "c", v: e.f()};
+      else {
+        var args = [];
+        stack = cons({c: "f", f: e.f, args: args, pos: 0, a: e.a.next}, stack);
+        e = e.a.data;
+      }
+      break;
+    case "l":
+      e = {c: "c", v: {env: env, body: e.b}};
+      break;
+    case "a":
+      stack = cons({c: "a1", x: e.x}, stack);
+      e = e.f;
+      break;
+    case "r":
+      if (e.l == null)
+        throw "Empty Ur record in interpretation";
+      var fs = {};
+      stack = cons({c: "r", n: e.l.data.n, fs: fs, l: e.l.next}, stack);
+      e = e.l.data;
+      break;
+    case ".":
+      stack = cons({c: ".", f: e.f}, stack);
+      e = e.r;
+      break;
+    case ";":
+      stack = cons({c: ";", e2: e.e2}, stack);
+      e = e.e1;
+      break;
+    case "=":
+      stack = cons({c: "=", e2: e.e2}, stack);
+      e = e.e1;
+      break;
+    case "e":
+      var env0 = env;
+      var e0 = e.e;
+      e = {c: "c", v: cs(function() { return exec0(env0, e0); })};
+      break;
+    default:
+      throw "Unknown Ur expression kind";
+    }
+  }
+}
+
+function exec(e) {
+  var r = exec0(null, e);
+
+  if (r != null && r.body)
+    return function(v) { return exec0(cons(v, r.env), r.body); };
+  else
+    return r;
 }
 
 
-- 
cgit v1.2.3