Hopefully complete refactoring of Jscomp to output ASTs; partial implementation of interpreter in runtime system (demo/alert works)

5 files changed, 406 insertions, 453 deletions

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;
 }
 
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index cd33a790..855841e1 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1286,12 +1286,12 @@ uw_Basis_int uw_Basis_new_client_source(uw_context ctx, uw_Basis_string s) {
   int len;
   size_t s_len = strlen(s);
 
-  uw_check_script(ctx, 12 + INTS_MAX + s_len);
-  sprintf(ctx->script.front, "var s%d=sc(%n", ctx->source_count, &len);
+  uw_check_script(ctx, 18 + INTS_MAX + s_len);
+  sprintf(ctx->script.front, "var s%d=sc(exec(%n", ctx->source_count, &len);
   ctx->script.front += len;
   strcpy(ctx->script.front, s);
   ctx->script.front += s_len;
-  strcpy(ctx->script.front, ");");
+  strcpy(ctx->script.front, "));");
   ctx->script.front += 2;
 
   return ctx->source_count++;
@@ -1301,12 +1301,12 @@ uw_unit uw_Basis_set_client_source(uw_context ctx, uw_Basis_int n, uw_Basis_stri
   int len;
   size_t s_len = strlen(s);
 
-  uw_check_script(ctx, 6 + INTS_MAX + s_len);
-  sprintf(ctx->script.front, "sv(s%d,%n", (int)n, &len);
+  uw_check_script(ctx, 12 + INTS_MAX + s_len);
+  sprintf(ctx->script.front, "sv(s%d,exec(%n", (int)n, &len);
   ctx->script.front += len;
   strcpy(ctx->script.front, s);
   ctx->script.front += s_len;
-  strcpy(ctx->script.front, ");");
+  strcpy(ctx->script.front, "));");
   ctx->script.front += 2;
 
   return uw_unit_v;
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 30f578c4..7d9ee955 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -51,132 +51,15 @@ type state = {
      maxName : int
 }
 
-fun varDepth (e, _) =
-    case e of
-        EPrim _ => 0
-      | ERel _ => 0
-      | ENamed _ => 0
-      | ECon (_, _, NONE) => 0
-      | ECon (_, _, SOME e) => varDepth e
-      | ENone _ => 0
-      | ESome (_, e) => varDepth e
-      | EFfi _ => 0
-      | EFfiApp (_, _, es) => foldl Int.max 0 (map varDepth es)
-      | EApp (e1, e2) => Int.max (varDepth e1, varDepth e2)
-      | EAbs _ => 0
-      | EUnop (_, e) => varDepth e
-      | EBinop (_, e1, e2) => Int.max (varDepth e1, varDepth e2)
-      | ERecord xes => foldl Int.max 0 (map (fn (_, e, _) => varDepth e) xes)
-      | EField (e, _) => varDepth e
-      | ECase (e, pes, _) =>
-        foldl Int.max (varDepth e)
-        (map (fn (p, e) => E.patBindsN p + varDepth e) pes)
-      | EStrcat (e1, e2) => Int.max (varDepth e1, varDepth e2)
-      | EError (e, _) => varDepth e
-      | EReturnBlob {blob = e1, mimeType = e2, ...} => Int.max (varDepth e1, varDepth e2)
-      | EWrite e => varDepth e
-      | ESeq (e1, e2) => Int.max (varDepth e1, varDepth e2)
-      | ELet (_, _, e1, e2) => Int.max (varDepth e1, 1 + varDepth e2)
-      | EClosure _ => 0
-      | EQuery _ => 0
-      | EDml _ => 0
-      | ENextval _ => 0
-      | EUnurlify _ => 0
-      | EJavaScript _ => 0
-      | ESignalReturn e => varDepth e
-      | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
-      | ESignalSource e => varDepth e
-      | EServerCall (e, ek, _, _) => Int.max (varDepth e, varDepth ek)
-      | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek)
-      | ESleep (e, ek) => Int.max (varDepth e, varDepth ek)
-
-fun closedUpto d =
-    let
-        fun cu inner (e, _) =
-            case e of
-                EPrim _ => true
-              | ERel n => n < inner orelse n - inner >= d
-              | ENamed _ => true
-              | ECon (_, _, NONE) => true
-              | ECon (_, _, SOME e) => cu inner e
-              | ENone _ => true
-              | ESome (_, e) => cu inner e
-              | EFfi _ => true
-              | EFfiApp (_, _, es) => List.all (cu inner) es
-              | EApp (e1, e2) => cu inner e1 andalso cu inner e2
-              | EAbs (_, _, _, e) => cu (inner + 1) e
-              | EUnop (_, e) => cu inner e
-              | EBinop (_, e1, e2) => cu inner e1 andalso cu inner e2
-              | ERecord xes => List.all (fn (_, e, _) => cu inner e) xes
-              | EField (e, _) => cu inner e
-              | ECase (e, pes, _) =>
-                cu inner e
-                andalso List.all (fn (p, e) => cu (inner + E.patBindsN p) e) pes
-              | EStrcat (e1, e2) => cu inner e1 andalso cu inner e2
-              | EError (e, _) => cu inner e
-              | EReturnBlob {blob = e1, mimeType = e2, ...} => cu inner e1 andalso cu inner e2
-              | EWrite e => cu inner e
-              | ESeq (e1, e2) => cu inner e1 andalso cu inner e2
-              | ELet (_, _, e1, e2) => cu inner e1 andalso cu (inner + 1) e2
-              | EClosure (_, es) => List.all (cu inner) es
-              | EQuery {query, body, initial, ...} =>
-                cu inner query
-                andalso cu (inner + 2) body
-                andalso cu inner initial
-              | EDml e => cu inner e
-              | ENextval e => cu inner e
-              | EUnurlify (e, _) => cu inner e
-              | EJavaScript (_, e) => cu inner e
-              | ESignalReturn e => cu inner e
-              | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
-              | ESignalSource e => cu inner e
-              | EServerCall (e, ek, _, _) => cu inner e andalso cu inner ek
-              | ERecv (e, ek, _) => cu inner e andalso cu inner ek
-              | ESleep (e, ek) => cu inner e andalso cu inner ek
-    in
-        cu 0
-    end
-
 fun strcat loc es =
     case es of
         [] => (EPrim (Prim.String ""), loc)
       | [x] => x
       | x :: es' => (EStrcat (x, strcat loc es'), loc)
 
-fun patDepth (p, _) =
-    case p of
-        PWild => 0
-      | PVar _ => 0
-      | PPrim _ => 0
-      | PCon (_, _, NONE) => 0
-      | PCon (_, _, SOME p) => 1 + patDepth p
-      | PRecord xpts => foldl Int.max 0 (map (fn (_, p, _) => 1 + patDepth p) xpts)
-      | PNone _ => 0
-      | PSome (_, p) => 1 + patDepth p
-
-val compact =
-    U.Exp.mapB {typ = fn t => t,
-                exp = fn inner => fn e =>
-                                     case e of
-                                         ERel n =>
-                                         if n >= inner then
-                                             ERel (n - inner)
-                                         else
-                                             e
-                                       | _ => e,
-                bind = fn (inner, b) =>
-                          case b of
-                              U.Exp.RelE _ => inner+1
-                            | _ => inner}
-
 exception CantEmbed of typ
 
-fun inString {needle, haystack} =
-    let
-        val (_, suffix) = Substring.position needle (Substring.full haystack)
-    in
-        not (Substring.isEmpty suffix)
-    end
+fun inString {needle, haystack} = String.isSubstring needle haystack
 
 fun process file =
     let
@@ -520,14 +403,12 @@ fun process file =
                     let
                         val str = str loc
 
-                        fun var n = Int.toString (len + inner - n - 1)
-
                         fun patCon pc =
                             case pc of
                                 PConVar n => str (Int.toString n)
                               | PConFfi {mod = "Basis", con = "True", ...} => str "true"
                               | PConFfi {mod = "Basis", con = "False", ...} => str "false"
-                              | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
+                              | PConFfi {con, ...} => str ("\"" ^ con ^ "\"")
 
                         fun unsupported s =
                             (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
@@ -566,98 +447,56 @@ fun process file =
                                   | _ => str (Prim.toString p)
                             end
 
-                        fun jsPat depth inner (p, _) succ fail =
+                        fun jsPat (p, _) =
                             case p of
-                                PWild => succ
-                              | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d"
-                                                       ^ Int.toString depth ^ ","),
-                                                  succ,
-                                                  str ")"]
-                              | PPrim p => strcat [str ("(d" ^ Int.toString depth ^ "=="),
+                                PWild => str "{c:\"w\"}"
+                              | PVar _ => str "{c:\"v\"}"
+                              | PPrim p => strcat [str "{c:\"c\",v:",
                                                    jsPrim p,
-                                                   str "?",
-                                                   succ,
-                                                   str ":",
-                                                   fail,
-                                                   str ")"]
+                                                   str "}"]
                               | PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE) =>
-                                strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                        succ,
-                                        str ":",
-                                        fail,
-                                        str ")"]
+                                str "{c:\"c\",v:true}"
                               | PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE) =>
-                                strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                        fail,
-                                        str ":",
-                                        succ,
-                                        str ")"]
+                                str "{c:\"c\",v:false}"
                               | PCon (Option, _, NONE) =>
-                                strcat [str ("(d" ^ Int.toString depth ^ "!=null?"),
-                                        fail,
-                                        str ":",
-                                        succ,
-                                        str ")"]
+                                str "{c:\"c\",v:null}"
                               | PCon (Option, PConVar n, SOME p) =>
                                 (case IM.find (someTs, n) of
                                      NONE => raise Fail "Jscomp: Not in someTs"
-                                   | SOME t =>
-                                     strcat [str ("(d" ^ Int.toString depth ^ "!=null?(d"
-                                                  ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth
-                                                  ^ (if isNullable t then
-                                                         ".v,"
-                                                     else
-                                                         "")
-                                                  ^ ","),
-                                             jsPat (depth+1) inner p succ fail,
-                                             str "):",
-                                             fail,
-                                             str ")"])
-                              | PCon (_, pc, NONE) =>
-                                strcat [str ("(d" ^ Int.toString depth ^ "=="),
-                                        patCon pc,
-                                        str "?",
-                                        succ,
-                                        str ":",
-                                        fail,
-                                        str ")"]
-                              | PCon (_, pc, SOME p) =>
-                                strcat [str ("(d" ^ Int.toString depth ^ ".n=="),
-                                        patCon pc,
-                                        str ("?(d" ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth ^ ".v,"),
-                                        jsPat (depth+1) inner p succ fail,
-                                        str "):",
-                                        fail,
-                                        str ")"]
-                              | PRecord xps =>
-                                let
-                                    val (_, succ) = foldl
-                                                        (fn ((x, p, _), (inner, succ)) =>
-                                                            (inner + E.patBindsN p,
-                                                             strcat [str ("(d" ^ Int.toString (depth+1) ^ "=d"
-                                                                          ^ Int.toString depth ^ "._" ^ x ^ ","),
-                                                                     jsPat (depth+1) inner p succ fail,
-                                                                     str ")"]))
-                                                        (inner, succ) xps
-                                in
-                                    succ
-                                end
-                              | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "!=null?"),
-                                                   fail,
-                                                   str ":",
-                                                   succ,
-                                                   str ")"]
-                              | PSome (t, p) => strcat [str ("(d" ^ Int.toString depth ^ "!=null?(d" ^ Int.toString (depth+1)
-                                                             ^ "=d" ^ Int.toString depth
+                                   | SOME t => strcat [str ("{c:\"s\",n:"
+                                                            ^ (if isNullable t then
+                                                                   "true"
+                                                               else
+                                                                   "false")
+                                                            ^ ",p:"),
+                                                       jsPat p,
+                                                       str "}"])
+                              | PCon (_, pc, NONE) => strcat [str "{c:\"0\",n:",
+                                                              patCon pc,
+                                                              str "}"]
+                              | PCon (_, pc, SOME p) => strcat [str "{c:\"1\",n:",
+                                                                patCon pc,
+                                                                str ",p:",
+                                                                jsPat p,
+                                                                str "}"]
+                              | PRecord xps => strcat [str "{c:\"r\",l:",
+                                                       foldr (fn ((x, p, _), e) =>
+                                                                 strcat [str ("cons({n:\"" ^ x ^ "\",p:"),
+                                                                         jsPat p,
+                                                                         str "},",
+                                                                         e,
+                                                                         str ")"])
+                                                             (str "null") xps,
+                                                       str "}"]
+                              | PNone _ => str "{c:\"c\",v:null}"
+                              | PSome (t, p) => strcat [str ("{c:\"s\",n:"
                                                              ^ (if isNullable t then
-                                                                    ".v"
+                                                                    "true"
                                                                 else
-                                                                    "")
-                                                             ^ ","),
-                                                        jsPat (depth+1) inner p succ fail,
-                                                        str "):",
-                                                        fail,
-                                                        str ")"]
+                                                                    "false")
+                                                             ^ ",p:"),
+                                                        jsPat p,
+                                                        str "}"]
 
                         val jsifyString = String.translate (fn #"\"" => "\\\""
                                                              | #"\\" => "\\\\"
@@ -677,39 +516,28 @@ fun process file =
                                       raise Fail "Jscomp: deStrcat")
 
                         val quoteExp = quoteExp loc
-
-                        val hasQuery = U.Exp.exists {typ = fn _ => false,
-                                                     exp = fn EQuery _ => true
-                                                            | _ => false}
-
-                        val indirectQuery = U.Exp.exists {typ = fn _ => false,
-                                                          exp = fn ENamed n =>
-                                                                   (case IM.find (nameds, n) of
-                                                                        NONE => false
-                                                                      | SOME e => hasQuery e)
-                                                                 | _ => false}
-
                     in
-                        (*if indirectQuery e then
-                            Print.preface ("Indirect", MonoPrint.p_exp MonoEnv.empty e)
-                        else
-                            ();*)
-
                         (*Print.prefaces "jsE" [("e", MonoPrint.p_exp MonoEnv.empty e),
                                               ("inner", Print.PD.string (Int.toString inner))];*)
 
                         case #1 e of
-                            EPrim p => (jsPrim p, st)
+                            EPrim p => (strcat [str "{c:\"c\",v:",
+                                                jsPrim p,
+                                                str "}"],
+                                        st)
                           | ERel n =>
                             if n < inner then
-                                (str ("_" ^ var n), st)
+                                (str ("{c:\"v\",n:" ^ Int.toString n ^ "}"), st)
                             else
                                 let
                                     val n = n - inner
                                     (*val () = Print.prefaces "quote" [("t", MonoPrint.p_typ MonoEnv.empty
                                                                            (List.nth (outer, n)))]*)
+                                    val (e, st) = quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
                                 in
-                                    quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
+                                    (strcat [str "{c:\"c\",v:",
+                                             e,
+                                             str "}"], st)
                                 end
 
                           | ENamed n =>
@@ -731,11 +559,11 @@ fun process file =
                                                           maxName = #maxName st}
 
                                                 val old = e
-                                                val (e, st) = jsExp mode [] 0 (e, st)
+                                                val (e, st) = jsExp mode [] (e, st)
                                                 val new = e
                                                 val e = deStrcat 0 e
                                                 
-                                                val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n"
+                                                val sc = "urfuncs[" ^ Int.toString n ^ "] = " ^ e ^ ";\n"
                                             in
                                                 (*Print.prefaces "jsify'" [("old", MonoPrint.p_exp MonoEnv.empty old),
                                                                          ("new", MonoPrint.p_exp MonoEnv.empty new)];*)
@@ -748,10 +576,10 @@ fun process file =
                                                  maxName = #maxName st}
                                             end
                             in
-                                (str ("_n" ^ Int.toString n), st)
+                                (str ("{c:\"n\",n:" ^ Int.toString n ^ "}"), st)
                             end
 
-                          | ECon (Option, _, NONE) => (str "null", st)
+                          | ECon (Option, _, NONE) => (str "{c:\"c\",v:null}", st)
                           | ECon (Option, PConVar n, SOME e) =>
                             let
                                 val (e, st) = jsE inner (e, st)
@@ -760,32 +588,35 @@ fun process file =
                                     NONE => raise Fail "Jscomp: Not in someTs [2]"
                                   | SOME t =>
                                     (if isNullable t then
-                                         strcat [str "{v:",
+                                         strcat [str "{c:\"s\",v:",
                                                  e,
                                                  str "}"]
                                      else
                                          e, st)
                             end
 
-                          | ECon (_, pc, NONE) => (patCon pc, st)
+                          | ECon (_, pc, NONE) => (strcat [str "{c:\"c\",v:",
+                                                           patCon pc,
+                                                           str "}"],
+                                                   st)
                           | ECon (_, pc, SOME e) =>
                             let
                                 val (s, st) = jsE inner (e, st)
                             in
-                                (strcat [str "{n:",
+                                (strcat [str "{c:\"1\",n:",
                                          patCon pc,
                                          str ",v:",
                                          s,
                                          str "}"], st)
                             end
 
-                          | ENone _ => (str "null", st)
+                          | ENone _ => (str "{c:\"c\",v:null}", st)
                           | ESome (t, e) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
                                 (if isNullable t then
-                                     strcat [str "{v:", e, str "}"]
+                                     strcat [str "{c:\"s\",v:", e, str "}"]
                                  else
                                      e, st)
                             end
@@ -798,12 +629,11 @@ fun process file =
                                                         "ERROR")
                                              | SOME s => s
                             in
-                                (str name, st)
+                                (str ("{c:\"c\",v:" ^ name ^ "}"), st)
                             end
-                          | EFfiApp ("Basis", "sigString", [_]) => (strcat [str "\"",
-                                                                           e,
-                                                                           str "\""], st)
-                          | EFfiApp ("Basis", "kc", []) => (str "kc(event)", st)
+                          | EFfiApp ("Basis", "sigString", [_]) => (strcat [str "{c:\"c\",v:\"",
+                                                                            e,
+                                                                            str "\"}"], st)
                           | EFfiApp (m, x, args) =>
                             let
                                 val name = case Settings.jsFunc (m, x) of
@@ -811,34 +641,24 @@ fun process file =
                                                                         ^ x ^ " in JavaScript");
                                                         "ERROR")
                                              | SOME s => s
+
+                                val (e, st) = foldr (fn (e, (acc, st)) =>
+                                                        let
+                                                            val (e, st) = jsE inner (e, st)
+                                                        in
+                                                            (strcat [str "cons(",
+                                                                     e,
+                                                                     str ",",
+                                                                     acc,
+                                                                     str ")"],
+                                                             st)
+                                                        end)
+                                              (str "null", st) args
                             in
-                                case args of
-                                    [] => (str (name ^ "()"), st)
-                                  | [e] =>
-                                    let
-                                        val (e, st) = jsE inner (e, st)
-                                    in
-                                        (strcat [str (name ^ "("),
-                                                 e,
-                                                 str ")"], st)
-                                    end
-                                  | e :: es =>
-                                    let
-                                        val (e, st) = jsE inner (e, st)
-                                        val (es, st) = ListUtil.foldlMapConcat
-                                                           (fn (e, st) =>
-                                                               let
-                                                                   val (e, st) = jsE inner (e, st)
-                                                               in
-                                                                   ([str ",", e], st)
-                                                               end)
-                                                           st es
-                                    in
-                                        (strcat (str (name ^ "(")
-                                                 :: e
-                                                 :: es
-                                                 @ [str ")"]), st)
-                                    end
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:"),
+                                         e,
+                                         str "}"],
+                                 st)
                             end
 
                           | EApp (e1, e2) =>
@@ -846,90 +666,80 @@ fun process file =
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [e1, str "(", e2, str ")"], st)
+                                (strcat [str "{c:\"a\",f:",
+                                         e1,
+                                         str ",x:",
+                                         e2,
+                                         str "}"], st)
                             end
                           | EAbs (_, _, _, e) =>
                             let
-                                val locals = List.tabulate
-                                                 (varDepth e,
-                                               fn i => str ("var _" ^ Int.toString (len + inner + i + 1) ^ ";"))
                                 val (e, st) = jsE (inner + 1) (e, st)
                             in
-                                (strcat (str ("function(_"
-                                              ^ Int.toString (len + inner)
-                                              ^ "){")
-                                         :: locals
-                                         @ [str "return ",
-                                            e,
-                                            str "}"]),
-                                 st)
+                                (strcat [str "{c:\"l\",b:",
+                                         e,
+                                         str "}"], st)
                             end
 
                           | EUnop (s, e) =>
                             let
+                                val name = case s of
+                                               "!" => "not"
+                                             | "-" => "neg"
+                                             | _ => raise Fail "Jscomp: Unknown unary operator"
+
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str ("(" ^ s),
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",:a:cons("),
                                          e,
-                                         str ")"],
+                                         str ",null)}"],
                                  st)
                             end
-                          | EBinop ("strcmp", e1, e2) =>
-                            let
-                                val (e1, st) = jsE inner (e1, st)
-                                val (e2, st) = jsE inner (e2, st)
-                            in
-                                (strcat [str "strcmp(",
-                                         e1,
-                                         str ",",
-                                         e2,
-                                         str ")"],
-                                 st)
-                            end                                
                           | EBinop (s, e1, e2) =>
                             let
-                                val s =
-                                    case s of
-                                        "!strcmp" => "=="
-                                      | _ => s
+                                val name = case s of
+                                               "==" => "eq"
+                                             | "!strcmp" => "eq"
+                                             | "+" => "plus"
+                                             | "-" => "minus"
+                                             | "*" => "times"
+                                             | "/" => "div"
+                                             | "%" => "mod"
+                                             | "<" => "lt"
+                                             | "<=" => "le"
+                                             | _ => raise Fail "Jscomp: Unknown binary operator"
 
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [str "(",
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:cons("),
                                          e1,
-                                         str s,
+                                         str ",cons(",
                                          e2,
-                                         str ")"],
+                                         str ",null))}"],
                                  st)
                             end
 
-                          | ERecord [] => (str "null", st)
-                          | ERecord [(x, e, _)] =>
-                            let
-                                val (e, st) = jsE inner (e, st)
-                            in
-                                (strcat [str ("{_" ^ x ^ ":"), e, str "}"], st)
-                            end
-                          | ERecord ((x, e, _) :: xes) =>
+                          | ERecord [] => (str "{c:\"c\",v:null}", st)
+                          | ERecord xes =>
                             let
-                                val (e, st) = jsE inner (e, st)
-
                                 val (es, st) =
                                     foldr (fn ((x, e, _), (es, st)) =>
                                               let
                                                   val (e, st) = jsE inner (e, st)
                                               in
-                                                  (str (",_" ^ x ^ ":")
-                                                   :: e
-                                                   :: es,
+                                                  (strcat [str ("cons({n:\"" ^ x ^ ",v:"),
+                                                           e,
+                                                           str "},",
+                                                           es,
+                                                           str ")"],
                                                    st)
                                               end)
-                                          ([str "}"], st) xes
+                                          (str "null", st) xes
                             in
-                                (strcat (str ("{_" ^ x ^ ":")
-                                         :: e
-                                         :: es),
+                                (strcat [str "{c:\"r\",l:",
+                                         es,
+                                         str "}"],
                                  st)
                             end
                           | EField (e', x) =>
@@ -938,8 +748,9 @@ fun process file =
                                     let
                                         val (e', st) = jsE inner (e', st)
                                     in
-                                        (strcat [e',
-                                                 str ("._" ^ x)], st)
+                                        (strcat [str "{c:\".\",r:",
+                                                 e',
+                                                 str (",f:\"" ^ x ^ "\"}")], st)
                                     end
 
                                 fun seek (e, xs) =
@@ -960,8 +771,12 @@ fun process file =
 
                                                 val e = (ERel n, loc)
                                                 val e = foldl (fn (x, e) => (EField (e, x), loc)) e xs
+                                                val (e, st) = quoteExp t (e, st)
                                             in
-                                                quoteExp t (e, st)
+                                                (strcat [str "{c:\"c\",v:",
+                                                         e,
+                                                         str "}"],
+                                                 st)
                                             end
                                       | EField (e', x) => seek (e', x :: xs)
                                       | _ => default ()
@@ -969,43 +784,31 @@ fun process file =
                                 seek (e', [x])
                             end  
 
-                          | ECase (e', pes, {result, ...}) =>
+                          | ECase (e', pes, _) =>
                             let
-                                val plen = length pes
+                                val (e', st) = jsE inner (e', st)
 
-                                val (cases, st) = ListUtil.foldliMap
-                                                      (fn (i, (p, e), st) =>
-                                                          let
-                                                              val (e, st) = jsE (inner + E.patBindsN p) (e, st)
-                                                              val fail =
-                                                                  if i = plen - 1 then
-                                                                      str ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")")
-                                                                  else
-                                                                      str ("c" ^ Int.toString (i+1) ^ "()")
-                                                              val c = jsPat 0 inner p e fail
-                                                          in
-                                                              (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
-                                                                       c,
-                                                                       str "},"],
-                                                               st)
-                                                          end)
-                                                      st pes
-
-                                val depth = foldl Int.max 0 (map (fn (p, _) => 1 + patDepth p) pes)
-                                val normalDepth = foldl Int.max 0 (map (fn (_, e) => 1 + varDepth e) pes)
-                                val (e, st) = jsE inner (e', st)
-
-                                val len = inner + len
-                                val normalVars = List.tabulate (normalDepth, fn n => "_" ^ Int.toString (n + len))
-                                val patVars = List.tabulate (depth, fn n => "d" ^ Int.toString n)
-                                val caseVars = ListUtil.mapi (fn (i, _) => "c" ^ Int.toString i) pes
+                                val (ps, st) =
+                                    foldr (fn ((p, e), (ps, st)) =>
+                                              let
+                                                  val (e, st) = jsE inner (e, st)
+                                              in
+                                                  (strcat [str "cons({p:",
+                                                           jsPat p,
+                                                           str ",b:",
+                                                           e,
+                                                           str "},",
+                                                           ps,
+                                                           str ")"],
+                                                   st)
+                                              end)
+                                          (str "null", st) pes
                             in
-                                (strcat (str "(function (){ var "
-                                         :: str (String.concatWith "," (normalVars @ patVars @ caseVars) ^ ";d0=")
-                                         :: e
-                                         :: str ";\nreturn ("
-                                         :: List.revAppend (cases,
-                                                            [str "c0()) } ())"])), st)
+                                (strcat [str "{c:\"m\",e:",
+                                         e,
+                                         str ",p:",
+                                         ps,
+                                         str "}"], st)
                             end
 
                           | EStrcat (e1, e2) =>
@@ -1013,43 +816,34 @@ fun process file =
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [str "cat(", e1, str ",", e2, str ")"], st)
+                                (strcat [str "{c:\"f\",f:cat,a:cons(", e1, str ",cons(", e2, str ",null))}"], st)
                             end
 
                           | EError (e, _) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str "er(", e, str ")"],
+                                (strcat [str "{c:\"f\",f:er,a:cons(", e, str ",null)}"],
                                  st)
                             end
 
-                          | EWrite e =>
-                            let
-                                val (e, st) = jsE inner (e, st)
-                            in
-                                (strcat [str "document.write(",
-                                         e,
-                                         str ".v)"], st)
-                            end
-
                           | ESeq (e1, e2) =>
                             let
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [str "(", e1, str ",", e2, str ")"], st)
+                                (strcat [str "{c:\";\",e1:", e1, str ",e2:", e2, str "}"], st)
                             end
                           | ELet (_, _, e1, e2) =>
                             let
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE (inner + 1) (e2, st)
                             in
-                                (strcat [str ("(_" ^ Int.toString (len + inner) ^ "="),
+                                (strcat [str "{c:\"=\",e1:",
                                          e1,
-                                         str ",",
+                                         str ",e2:",
                                          e2,
-                                         str ")"], st)
+                                         str "}"], st)
                             end
 
                           | EJavaScript (Source _, e) =>
@@ -1057,21 +851,16 @@ fun process file =
                              jsE inner (e, st))
                           | EJavaScript (_, e) =>
                             let
-                                val locals = List.tabulate
-                                                 (varDepth e,
-                                               fn i => str ("var _" ^ Int.toString (len + inner + i) ^ ";"))
-
                                 val (e, st) = jsE inner (e, st)
                             in
                                 foundJavaScript := true;
-                                (strcat (str "cs(function(){"
-                                         :: locals
-                                         @ [str "return ",
-                                            (*compact inner*) e,
-                                            str "})"]),
+                                (strcat [str "{c:\"e\",e:",
+                                         e,
+                                         str "}"],
                                  st)
                             end
 
+                          | EWrite _ => unsupported "EWrite"
                           | EClosure _ => unsupported "EClosure"
                           | EQuery _ => unsupported "Query"
                           | EDml _ => unsupported "DML"
@@ -1083,9 +872,9 @@ fun process file =
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str "sr(",
+                                (strcat [str "{c:\"f\",f:sr,a:cons(",
                                          e,
-                                         str ")"],
+                                         str ",null)}"],
                                  st)
                             end
                           | ESignalBind (e1, e2) =>
@@ -1093,20 +882,20 @@ fun process file =
                                 val (e1, st) = jsE inner (e1, st)
                                 val (e2, st) = jsE inner (e2, st)
                             in
-                                (strcat [str "sb(",
+                                (strcat [str "{c:\"b\",e1:",
                                          e1,
-                                         str ",",
+                                         str ",e2:",
                                          e2,
-                                         str ")"],
+                                         str "}"],
                                  st)
                             end
                           | ESignalSource e =>
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str "ss(",
+                                (strcat [str "{c:\"f\",f:ss,a:cons(",
                                          e,
-                                         str ")"],
+                                         str ",null)}"],
                                  st)
                             end
 
@@ -1116,16 +905,18 @@ fun process file =
                                 val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
-                                (strcat [str ("rc(cat(\"" ^ Settings.getUrlPrefix () ^ "\","),
+                                (strcat [str ("{c:\"f\",f:rc,a:cons({c:\"c\",v:\""
+                                              ^ Settings.getUrlPrefix ()
+                                              ^ "\"},cons("),
                                          e,
-                                         str ("), function(s){var t=s.split(\"/\");var i=0;return "
-                                              ^ unurl ^ "},"),
+                                         str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ unurl ^ "}},cons({c:\"!\",e:"),
                                          ek,
-                                         str (","
+                                         str ("},cons("
                                               ^ (case eff of
                                                      ReadCookieWrite => "true"
                                                    | _ => "false")
-                                              ^ ")")],
+                                              ^ ",null)))))}")],
                                  st)
                             end
 
@@ -1135,12 +926,12 @@ fun process file =
                                 val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
-                                (strcat [str "rv(",
+                                (strcat [str ("{c:\"f\",f:rv,a:cons("),
                                          e,
-                                         str (", function(s){var t=s.split(\"/\");var i=0;return "
-                                              ^ unurl ^ "},"),
+                                         str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ unurl ^ "}},cons({c:\"!\",e:"),
                                          ek,
-                                         str ")"],
+                                         str ("},null)))}")],
                                  st)
                             end
 
@@ -1149,19 +940,18 @@ fun process file =
                                 val (e, st) = jsE inner (e, st)
                                 val (ek, st) = jsE inner (ek, st)
                             in
-                                (strcat [str "window.setTimeout(",
+                                (strcat [str "{c:\"f\",f:window.setTimeout,a:cons(",
                                          ek,
-                                         str ", ",
+                                         str ",cons(",
                                          e,
-                                         str ")"],
+                                         str ",null))}"],
                                  st)
                             end
                     end
             in
-                jsE
+                jsE 0
             end
 
-
         fun patBinds ((p, _), env) =
             case p of
                 PWild => env
@@ -1350,28 +1140,9 @@ fun process file =
                  end
 
                | EJavaScript (m, e') =>
-                 (let
-                      val len = length outer
-                      fun str s = (EPrim (Prim.String s), #2 e')
-
-                      val locals = List.tabulate
-                                       (varDepth e',
-                                     fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
-
-                      val (e', st) = jsExp m outer 0 (e', st)
-
-                      val e' =
-                          case locals of
-                              [] => e'
-                            | _ =>
-                              strcat (#2 e') (str "(function(){"
-                                              :: locals
-                                              @ [str "return ",
-                                                 e',
-                                                 str "}())"])
-                  in
-                      (e', st)
-                  end handle CantEmbed _ => (e, st))
+                 (foundJavaScript := true;
+                  jsExp m outer (e', st)
+                  handle CantEmbed _ => (e, st))
 
                | ESignalReturn e =>
                  let
diff --git a/src/monoize.sml b/src/monoize.sml
index 00230d1a..c0ae1fee 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2522,17 +2522,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                     | (L'.TFun (dom, _), _) =>
                                       let
                                           val s' = " " ^ lowercaseFirst x ^ "='"
-                                          val e = case #1 dom of
-                                                      L'.TRecord [] => (L'.EApp (e, (L'.ERecord [], loc)), loc)
-                                                    | _ => (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
-                                                                      loc), (L'.ERecord [], loc)), loc)
+                                          val (e, s') =
+                                              case #1 dom of
+                                                  L'.TRecord [] => ((L'.EApp (e, (L'.ERecord [], loc)), loc), s')
+                                                | _ => ((L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
+                                                                   loc), (L'.ERecord [], loc)), loc),
+                                                        s' ^ "uwe=event;")
+                                          val s' = s' ^ "exec("
                                       in
                                           ((L'.EStrcat (s,
                                                         (L'.EStrcat (
                                                          (L'.EPrim (Prim.String s'), loc),
                                                          (L'.EStrcat (
                                                           (L'.EJavaScript (L'.Attribute, e), loc),
-                                                          (L'.EPrim (Prim.String ";return false'"), loc)), loc)),
+                                                          (L'.EPrim (Prim.String ");return false'"), loc)), loc)),
                                                          loc)), loc),
                                            fm)
                                       end
@@ -2621,13 +2624,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         val assgns = List.mapPartial
                                      (fn ("Source", _, _) => NONE
                                        | ("Onchange", e, _) =>
-                                         SOME (strcat [str "addOnChange(d,",
+                                         SOME (strcat [str "addOnChange(d,exec(",
                                                        (L'.EJavaScript (L'.Script, e), loc),
-                                                       str ")"])
+                                                       str "))"])
                                        | (x, e, _) =>
-                                         SOME (strcat [str ("d." ^ lowercaseFirst x ^ "="),
+                                         SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
                                                        (L'.EJavaScript (L'.Script, e), loc),
-                                                       str ";"]))
+                                                       str ");"]))
                                      attrs
                     in
                         case assgns of
@@ -2646,7 +2649,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                          let
                                              val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
                                          in
-                                             (L'.EJavaScript (L'.Attribute, e), loc)
+                                             (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
+                                                          (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
+                                                                       (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
                                          end
                     in
                         normal ("body",
@@ -2677,9 +2682,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             [("Signal", e, _)] =>
                             ((L'.EStrcat
                                   ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
-                                                           ^ tag ^ "\", ")), loc),
+                                                           ^ tag ^ "\", exec(")), loc),
                                    (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
-                                                (L'.EPrim (Prim.String (")</script>")), loc)), loc)), loc),
+                                                (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
                              fm)
                           | _ => raise Fail "Monoize: Bad dyn attributes"
                     end
@@ -2701,9 +2706,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                  loc)), loc), fm)
                               end
                             | SOME (_, src, _) =>
-                              (strcat [str "<script type=\"text/javascript\">inp(",
+                              (strcat [str "<script type=\"text/javascript\">inp(exec(",
                                        (L'.EJavaScript (L'.Script, src), loc),
-                                       str ")</script>"],
+                                       str "))</script>"],
                                fm))
                        | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                                raise Fail "No name passed to textbox tag"))
@@ -2773,9 +2778,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                          end
                        | SOME (_, src, _) =>
                          let
-                             val sc = strcat [str "inp(",
+                             val sc = strcat [str "inp(exec(",
                                               (L'.EJavaScript (L'.Script, src), loc),
-                                              str ")"]
+                                              str "))"]
                              val sc = setAttrs sc
                          in
                              (strcat [str "<script type=\"text/javascript\">",
@@ -2796,9 +2801,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                          end
                        | SOME (_, src, _) =>
                          let
-                             val sc = strcat [str "chk(",
+                             val sc = strcat [str "chk(exec(",
                                               (L'.EJavaScript (L'.Script, src), loc),
-                                              str ")"]
+                                              str "))"]
                              val sc = setAttrs sc
                          in
                              (strcat [str "<script type=\"text/javascript\">",
@@ -2824,11 +2829,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                          let
                              val (xml, fm) = monoExp (env, st, fm) xml
 
-                             val sc = strcat [str "sel(",
+                             val sc = strcat [str "sel(exec(",
                                               (L'.EJavaScript (L'.Script, src), loc),
                                               str ",",
                                               (L'.EJavaScript (L'.Script, xml), loc),
-                                              str ")"]
+                                              str "))"]
                              val sc = setAttrs sc
                          in
                              (strcat [str "<script type=\"text/javascript\">",
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index 09e9e884..c4623fc3 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -67,7 +67,7 @@ val events = ["abort",
               "unload"]
                 
 val scriptWords = "<script"
-                   :: map (fn s => "on" ^ s ^ " ='") events
+                   :: map (fn s => " on" ^ s ^ "='") events
 
 val pushWords = ["rv("]
 
@@ -75,12 +75,7 @@ fun classify (ds, ps) =
     let
         val proto = Settings.currentProtocol ()
 
-        fun inString {needle, haystack} =
-            let
-                val (_, suffix) = Substring.position needle (Substring.full haystack)
-            in
-                not (Substring.isEmpty suffix)
-            end
+        fun inString {needle, haystack} = String.isSubstring needle haystack
 
         fun hasClient {basis, words, onload} csids =
             let