Merge branch 'upstream' into dfsg_clean20170720+dfsg

18 files changed, 269 insertions, 82 deletions

diff --git a/src/c/http.c b/src/c/http.c
index 1bc58677..21ad809f 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -75,6 +75,8 @@ static void log_debug(void *data, const char *fmt, ...) {
 
 static uw_loggers ls = {NULL, log_error, log_debug};
 
+static unsigned max_buf_size = 1024 * 1024; // That's 1MB.
+
 static void *worker(void *data) {
   int me = *(int *)data;
   uw_context ctx = uw_request_new_context(me, &uw_application, &ls);
@@ -100,6 +102,12 @@ static void *worker(void *data) {
       if (back - buf == buf_size - 1) {
         char *new_buf;
         size_t new_buf_size = buf_size*2;
+        if (new_buf_size > max_buf_size) {
+          qfprintf(stderr, "HTTP input exceeds buffer-size limit of %u bytes.\n", max_buf_size);
+          close(sock);
+          sock = 0;
+          break;
+        }
         new_buf = realloc(buf, new_buf_size);
         if(!new_buf) {
           qfprintf(stderr, "Realloc failed while receiving header\n");
@@ -156,6 +164,12 @@ static void *worker(void *data) {
             if (back - buf == buf_size - 1) {
               char *new_buf;
               size_t new_buf_size = buf_size * 2;
+              if (new_buf_size > max_buf_size) {
+                qfprintf(stderr, "HTTP input exceeds buffer-size limit of %u bytes.\n", max_buf_size);
+                close(sock);
+                sock = 0;
+                break;
+              }
               new_buf = realloc(buf, new_buf_size);
               if(!new_buf) {
                 qfprintf(stderr, "Realloc failed while receiving content\n");
@@ -314,7 +328,7 @@ static void *worker(void *data) {
 }
 
 static void help(char *cmd) {
-  printf("Usage: %s [-p <port>] [-a <IPv4 address>] [-A <IPv6 address>] [-t <thread count>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\n", cmd);
+  printf("Usage: %s [-p <port>] [-a <IPv4 address>] [-A <IPv6 address>] [-t <thread count>] [-m <bytes>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\nThe '-m' sets the maximum size (in bytes) for any buffer used to hold HTTP data sent by clients.  (The default is 1 MB.)\n", cmd);
 }
 
 static void sigint(int signum) {
@@ -345,7 +359,7 @@ int main(int argc, char *argv[]) {
   my_addr.sa.sa_family = AF_INET;
   my_addr.ipv4.sin_addr.s_addr = INADDR_ANY; // auto-fill with my IP
 
-  while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:")) != -1) {
+  while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:m:")) != -1) {
     switch (opt) {
     case '?':
       fprintf(stderr, "Unknown command-line option\n");
@@ -409,6 +423,16 @@ int main(int argc, char *argv[]) {
       quiet = 1;
       break;
 
+    case 'm':
+      opt = atoi(optarg);
+      if (opt <= 0) {
+        fprintf(stderr, "Invalid maximum buffer size\n");
+        help(argv[0]);
+        return 1;
+      }
+      max_buf_size = opt;
+      break;
+
     default:
       fprintf(stderr, "Unexpected getopt() behavior\n");
       return 1;
@@ -456,6 +480,10 @@ int main(int argc, char *argv[]) {
 
   sin_size = sizeof their_addr;
 
+  qprintf("Starting the Ur/Web native HTTP server, which is intended for use\n"
+          "ONLY DURING DEVELOPMENT.  You probably want to use one of the other backends,\n"
+          "behind a production-quality HTTP server, for a real deployment.\n\n");
+
   qprintf("Listening on port %d....\n", uw_port);
 
   {
diff --git a/src/c/static.c b/src/c/static.c
index 7f63d393..d70881e2 100644
--- a/src/c/static.c
+++ b/src/c/static.c
@@ -38,6 +38,7 @@ int main(int argc, char *argv[]) {
     fk = uw_begin(ctx, argv[1]);
 
     if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
+      uw_commit(ctx);
       uw_print(ctx, 1);
       puts("");
       return 0;
diff --git a/src/c/urweb.c b/src/c/urweb.c
index afe8457b..6f2dde38 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -180,8 +180,11 @@ static uw_Basis_int my_rand() {
     return -1;
 }
 
-static client *new_client() {
+static client *new_client(uw_context ctx) {
   client *c;
+  int pass = my_rand();
+
+  if (pass < 0) uw_error(ctx, FATAL, "Random number generation failed during client initialization");
 
   pthread_mutex_lock(&clients_mutex);
 
@@ -205,7 +208,7 @@ static client *new_client() {
 
   pthread_mutex_lock(&c->lock);
   c->mode = USED;
-  c->pass = my_rand();
+  c->pass = pass;
   c->sock = -1;
   c->last_contact = time(NULL);
   uw_buffer_reset(&c->msgs);
@@ -817,7 +820,7 @@ void uw_login(uw_context ctx) {
         uw_error(ctx, FATAL, "Wrong client password (%u, %d) in subscription request", id, pass);
     }
   } else if (ctx->needs_push) {
-    client *c = new_client();
+    client *c = new_client(ctx);
 
     if (c == NULL)
       uw_error(ctx, FATAL, "Limit exceeded on number of message-passing clients");
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 688b3e4d..53587ff7 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2513,8 +2513,12 @@ fun p_decl env (dAll as (d, loc) : decl) =
 
       | DJavaScript s =>
         let
+	    val name =
+		(case Settings.getOutputJsFile () of
+		    NONE => "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"
+		  | SOME s => s)
             val () = app_js := OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
-                                                    file = "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"}
+                                                    file = name}
         in
             box [string "static char jslib[] = \"",
                  string (Prim.toCString s),
diff --git a/src/compiler.sig b/src/compiler.sig
index a4b3e562..952c7070 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -48,6 +48,7 @@ signature COMPILER = sig
          benignEffectful : Settings.ffi list,
          clientOnly : Settings.ffi list,
          serverOnly : Settings.ffi list,
+         jsModule : string option,
          jsFuncs : (Settings.ffi * string) list,
          rewrites : Settings.rewrite list,
          filterUrl : Settings.rule list,
diff --git a/src/compiler.sml b/src/compiler.sml
index 481f04b6..c13de304 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -52,6 +52,7 @@ type job = {
      benignEffectful : Settings.ffi list,
      clientOnly : Settings.ffi list,
      serverOnly : Settings.ffi list,
+     jsModule : string option,
      jsFuncs : (Settings.ffi * string) list,
      rewrites : Settings.rewrite list,
      filterUrl : Settings.rule list,
@@ -273,7 +274,7 @@ val parseUr = {
 
 fun p_job ({prefix, database, exe, sql, sources, debug, profile,
             timeout, ffi, link, headers, scripts,
-            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
+            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsModule, jsFuncs, ...} : job) =
     let
         open Print.PD
         open Print
@@ -312,6 +313,9 @@ fun p_job ({prefix, database, exe, sql, sources, debug, profile,
              p_ffi "BenignEffectful" benignEffectful,
              p_ffi "ClientOnly" clientOnly,
              p_ffi "ServerOnly" serverOnly,
+             case jsModule of
+                 NONE => string "No JavaScript FFI module"
+               | SOME m => string ("JavaScript FFI module: " ^ m),
              p_list_sep (box []) (fn ((m, s), s') =>
                                      box [string "JsFunc", space, string m, string ".", string s,
                                           space, string "=", space, string s', newline]) jsFuncs,
@@ -368,6 +372,7 @@ fun institutionalizeJob (job : job) =
      Settings.setBenignEffectful (#benignEffectful job);
      Settings.setClientOnly (#clientOnly job);
      Settings.setServerOnly (#serverOnly job);
+     Settings.setJsModule (#jsModule job);
      Settings.setJsFuncs (#jsFuncs job);
      Settings.setRewriteRules (#rewrites job);
      Settings.setUrlRules (#filterUrl job);
@@ -445,6 +450,7 @@ fun parseUrp' accLibs fname =
                         benignEffectful = [],
                         clientOnly = [],
                         serverOnly = [],
+                        jsModule = NONE,
                         jsFuncs = [],
                         rewrites = [{pkind = Settings.Any,
                                      kind = Settings.Prefix,
@@ -543,9 +549,16 @@ fun parseUrp' accLibs fname =
                                                acc
                                            else
                                                let
-                                                   val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
-                                                                                           (String.explode line))
-                                                   val fname = relifyA fname
+                                                   fun trim s =
+                                                       let
+                                                           val s = Substring.full s
+                                                           val (_, s) = Substring.splitl Char.isSpace s
+                                                           val (s, _) = Substring.splitr Char.isSpace s
+                                                       in
+                                                           Substring.string s
+                                                       end
+
+                                                   val fname = relifyA (trim line)
                                                in
                                                    fname :: acc
                                                end
@@ -572,6 +585,7 @@ fun parseUrp' accLibs fname =
                      val benignEffectful = ref []
                      val clientOnly = ref []
                      val serverOnly = ref []
+                     val jsModule = ref NONE
                      val jsFuncs = ref []
                      val rewrites = ref []
                      val url = ref []
@@ -609,6 +623,7 @@ fun parseUrp' accLibs fname =
                                  benignEffectful = rev (!benignEffectful),
                                  clientOnly = rev (!clientOnly),
                                  serverOnly = rev (!serverOnly),
+                                 jsModule = !jsModule,
                                  jsFuncs = rev (!jsFuncs),
                                  rewrites = rev (!rewrites),
                                  filterUrl = rev (!url),
@@ -667,6 +682,7 @@ fun parseUrp' accLibs fname =
                                  benignEffectful = #benignEffectful old @ #benignEffectful new,
                                  clientOnly = #clientOnly old @ #clientOnly new,
                                  serverOnly = #serverOnly old @ #serverOnly new,
+                                 jsModule = #jsModule old,
                                  jsFuncs = #jsFuncs old @ #jsFuncs new,
                                  rewrites = #rewrites old @ #rewrites new,
                                  filterUrl = #filterUrl old @ #filterUrl new,
@@ -802,6 +818,10 @@ fun parseUrp' accLibs fname =
                                    | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
                                    | "clientOnly" => clientOnly := ffiS () :: !clientOnly
                                    | "serverOnly" => serverOnly := ffiS () :: !serverOnly
+                                   | "jsModule" =>
+                                     (case !jsModule of
+                                          NONE => jsModule := SOME arg
+                                        | SOME _ => ())
                                    | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
                                    | "rewrite" =>
                                      let
@@ -1005,6 +1025,8 @@ val parse = {
                   val defed = ref SS.empty
                   val fulls = ref SS.empty
 
+                  val caughtOneThatIsn'tAFile = ref false
+
                   fun parseOne fname =
                       let
                           val mname = nameOf fname
@@ -1129,7 +1151,16 @@ val parse = {
                       in
                           checkErrors ();
                           d
-                      end handle MissingFile fname => (ErrorMsg.error ("Missing source file: " ^ fname);
+                      end handle MissingFile fname => (if not (!caughtOneThatIsn'tAFile)
+                                                          andalso CharVector.exists Char.isSpace fname then
+                                                           (caughtOneThatIsn'tAFile := true;
+                                                            ErrorMsg.error ("In .urp files, all configuration directives must come before any blank lines.\n"
+                                                                            ^ "However, this .urp file contains at least one suspicious line in a position\n"
+                                                                            ^ "where filenames belong (after the first blank line) but containing a space\n"
+                                                                            ^ "character."))
+                                                       else
+                                                           ();
+                                                       ErrorMsg.error ("Missing source file: " ^ fname);
                                                        (Source.DSequence "", ErrorMsg.dummySpan))
 
                   val dsFfi = map parseFfi ffi
diff --git a/src/demo.sml b/src/demo.sml
index 47d22395..62b9037a 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -16,7 +16,7 @@
  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
@@ -111,6 +111,7 @@ fun make' {prefix, dirname, guided} =
             benignEffectful = [],
             clientOnly = [],
             serverOnly = [],
+            jsModule = NONE,
             jsFuncs = [],
             rewrites = #rewrites combined @ #rewrites urp,
             filterUrl = #filterUrl combined @ #filterUrl urp,
@@ -280,7 +281,7 @@ fun make' {prefix, dirname, guided} =
                             val (urpData, out) = startUrp urp
                         in
                             finished ();
-                            
+
                             SOME (readUrp (urpData,
                                            out))
                         end
@@ -399,7 +400,7 @@ fun make' {prefix, dirname, guided} =
                              case #kind rule of
                                  Settings.Exact => ()
                                | Settings.Prefix => TextIO.output (outf, "*");
-                             TextIO.output (outf, "\n")))                  
+                             TextIO.output (outf, "\n")))
             in
                 Option.app (fn db => (TextIO.output (outf, "database ");
                                       TextIO.output (outf, db);
diff --git a/src/elab_env.sig b/src/elab_env.sig
index cbc85cdd..47b31c08 100644
--- a/src/elab_env.sig
+++ b/src/elab_env.sig
@@ -96,6 +96,7 @@ signature ELAB_ENV = sig
 
     val pushStrNamed : env -> string -> Elab.sgn -> env * int
     val pushStrNamedAs : env -> string -> int -> Elab.sgn -> env
+    val pushStrNamedAs' : bool (* also enrich typeclass instances? *) -> env -> string -> int -> Elab.sgn -> env
     val lookupStrNamed : env -> int -> string * Elab.sgn
 
     val lookupStr : env -> string -> (int * Elab.sgn) option
@@ -123,6 +124,4 @@ signature ELAB_ENV = sig
     val patBinds : env -> Elab.pat -> env
     val patBindsN : Elab.pat -> int
 
-    exception Bad of Elab.con * Elab.con
-
 end
diff --git a/src/elab_env.sml b/src/elab_env.sml
index cb08f348..8402bcba 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -1097,14 +1097,21 @@ fun sgnS_sgn (str, (sgns, strs, cons)) sgn =
              end)
       | _ => sgn
 
-fun sgnSubSgn x =
+fun projectStr env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        (case sgnSeek (fn SgiStr (_, x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of
+             NONE => NONE
+           | SOME (sgn, subs) => SOME (sgnSubSgn (str, subs) sgn))
+      | SgnError => SOME (SgnError, ErrorMsg.dummySpan)
+      | _ => NONE
+
+and sgnSubSgn x =
     ElabUtil.Sgn.map {kind = id,
                       con = sgnS_con x,
                       sgn_item = id,
                       sgn = sgnS_sgn x}
 
-
-
 and projectSgn env {sgn, str, field} =
     case #1 (hnormSgn env sgn) of
         SgnConst sgis =>
@@ -1123,12 +1130,23 @@ and hnormSgn env (all as (sgn, loc)) =
       | SgnProj (m, ms, x) =>
         let
             val (_, sgn) = lookupStrNamed env m
+
+            fun doProjection (m1, NONE) = NONE
+              | doProjection (m1, SOME (str, sgn)) =
+                case projectStr env {str = str,
+                                     sgn = sgn,
+                                     field = m1} of
+                    NONE => NONE
+                  | SOME sgn' => SOME ((StrProj (str, m1), loc), sgn')
         in
-            case projectSgn env {str = foldl (fn (m, str) => (StrProj (str, m), loc)) (StrVar m, loc) ms,
-                                 sgn = sgn,
-                                 field = x} of
-                NONE => raise Fail "ElabEnv.hnormSgn: projectSgn failed"
-              | SOME sgn => hnormSgn env sgn
+            case foldl doProjection (SOME ((StrVar m, loc), sgn)) ms of
+                NONE => raise Fail "ElabEnv.hnormSgn: pre-projectSgn failed"
+              | SOME (str, sgn) =>
+                case projectSgn env {str = str,
+                                     sgn = sgn,
+                                     field = x} of
+                    NONE => raise Fail "ElabEnv.hnormSgn: projectSgn failed"
+                  | SOME sgn => hnormSgn env sgn
         end
       | SgnWhere (sgn, ms, x, c) =>
 	let
@@ -1281,28 +1299,40 @@ fun enrichClasses env classes (m1, ms) sgn =
         end
       | _ => classes
 
-fun pushStrNamedAs (env : env) x n sgn =
-    {renameK = #renameK env,
-     relK = #relK env,
+and pushStrNamedAs' enrich (env : env) x n sgn =
+    let
+        val renameStr = SM.insert (#renameStr env, x, (n, sgn))
+        val str = IM.insert (#str env, n, (x, sgn))
+        fun newEnv classes =
+            {renameK = #renameK env,
+             relK = #relK env,
 
-     renameC = #renameC env,
-     relC = #relC env,
-     namedC = #namedC env,
+             renameC = #renameC env,
+             relC = #relC env,
+             namedC = #namedC env,
 
-     datatypes = #datatypes env,
-     constructors = #constructors env,
+             datatypes = #datatypes env,
+             constructors = #constructors env,
 
-     classes = enrichClasses env (#classes env) (n, []) sgn,
+             classes = classes,
 
-     renameE = #renameE env,
-     relE = #relE env,
-     namedE = #namedE env,
+             renameE = #renameE env,
+             relE = #relE env,
+             namedE = #namedE env,
 
-     renameSgn = #renameSgn env,
-     sgn = #sgn env,
+             renameSgn = #renameSgn env,
+             sgn = #sgn env,
+
+             renameStr = renameStr,
+             str = str}
+    in
+        if enrich then
+            newEnv (enrichClasses (newEnv (#classes env)) (#classes env) (n, []) sgn)
+        else
+            newEnv (#classes env)
+    end
 
-     renameStr = SM.insert (#renameStr env, x, (n, sgn)),
-     str = IM.insert (#str env, n, (x, sgn))}
+and pushStrNamedAs env = pushStrNamedAs' true env
 
 fun pushStrNamed env x sgn =
     let
@@ -1364,7 +1394,7 @@ fun sgiBinds env (sgi, loc) =
             env xncs
         end
       | SgiVal (x, n, t) => pushENamedAs env x n t
-      | SgiStr (_, x, n, sgn) => pushStrNamedAs env x n sgn
+      | SgiStr (_, x, n, sgn) => pushStrNamedAs' false env x n sgn
       | SgiSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
       | SgiConstraint _ => env
 
@@ -1375,15 +1405,6 @@ fun sgnSubCon x =
     ElabUtil.Con.map {kind = id,
                       con = sgnS_con x}
 
-fun projectStr env {sgn, str, field} =
-    case #1 (hnormSgn env sgn) of
-        SgnConst sgis =>
-        (case sgnSeek (fn SgiStr (_, x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of
-             NONE => NONE
-           | SOME (sgn, subs) => SOME (sgnSubSgn (str, subs) sgn))
-      | SgnError => SOME (SgnError, ErrorMsg.dummySpan)
-      | _ => NONE
-
 fun chaseMpath env (n, ms) =
     let
         val (_, sgn) = lookupStrNamed env n
@@ -1642,8 +1663,8 @@ fun declBinds env (d, loc) =
       | DVal (x, n, t, _) => pushENamedAs env x n t
       | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamedAs env x n t) env vis
       | DSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
-      | DStr (x, n, sgn, _) => pushStrNamedAs env x n sgn
-      | DFfiStr (x, n, sgn) => pushStrNamedAs env x n sgn
+      | DStr (x, n, sgn, _) => pushStrNamedAs' false env x n sgn
+      | DFfiStr (x, n, sgn) => pushStrNamedAs' false env x n sgn
       | DConstraint _ => env
       | DExport _ => env
       | DTable (tn, x, n, c, _, pc, _, cc) =>
diff --git a/src/elab_print.sml b/src/elab_print.sml
index 06ea097f..8a6a651a 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -678,7 +678,7 @@ and p_sgn env (sgn, _) =
                                          space,
                                          string ":",
                                          space,
-                                         p_sgn (E.pushStrNamedAs env x n sgn) sgn']
+                                         p_sgn (E.pushStrNamedAs' false env x n sgn) sgn']
       | SgnWhere (sgn, ms, x, c) => box [p_sgn env sgn,
 					 space,
 					 string "where",
@@ -695,7 +695,7 @@ and p_sgn env (sgn, _) =
             val m1x = #1 (E.lookupStrNamed env m1)
                 handle E.UnboundNamed _ => "UNBOUND_SGN_" ^ Int.toString m1
                    
-            val m1s = if !debug then
+            val m1x = if !debug then
                           m1x ^ "__" ^ Int.toString m1
                       else
                           m1x
@@ -867,7 +867,7 @@ and p_str env (str, _) =
                                  string s]
       | StrFun (x, n, sgn, sgn', str) =>
         let
-            val env' = E.pushStrNamedAs env x n sgn
+            val env' = E.pushStrNamedAs' false env x n sgn
         in
             box [string "functor",
                  space,
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 6965adfd..4a04d4bf 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2489,6 +2489,15 @@ fun queryOf () = (L'.CModProj (!basis_r, [], "sql_query"), ErrorMsg.dummySpan)
 fun cookieOf () = (L'.CModProj (!basis_r, [], "http_cookie"), ErrorMsg.dummySpan)
 fun styleOf () = (L'.CModProj (!basis_r, [], "css_class"), ErrorMsg.dummySpan)
 
+fun patVarsOf (p : L.pat) =
+    case #1 p of
+        L.PVar x => [x]
+      | L.PPrim _ => []
+      | L.PCon (_, _, NONE) => []
+      | L.PCon (_, _, SOME p) => patVarsOf p
+      | L.PRecord (xps, _) => ListUtil.mapConcat (fn (_, p) => patVarsOf p) xps
+      | L.PAnnot (p', _) => patVarsOf p'
+
 fun dopenConstraints (loc, env, denv) {str, strs} =
     case E.lookupStr env str of
         NONE => (strError env (UnboundStr (loc, str));
@@ -3807,7 +3816,8 @@ and wildifyStr env (str, sgn) =
                      foldl (fn ((d, _), nd) =>
                                case d of
                                    L.DCon (x, _, _) => ndelCon (nd, x)
-                                 | L.DVal (x, _, _) => ndelVal (nd, x)
+                                 | L.DVal (p, _) =>
+                                   foldl (fn (x, nd) => ndelVal (nd, x)) nd (patVarsOf p)
                                  | L.DOpen _ => nempty
                                  | L.DStr (x, _, _, (L.StrConst ds', _), _) =>
                                    (case SM.find (nmods nd, x) of
@@ -3855,7 +3865,7 @@ and wildifyStr env (str, sgn) =
                                | xs =>
                                  let
                                      val ewild = (L.EWild, #2 str)
-                                     val ds'' = map (fn x => (L.DVal (x, NONE, ewild), #2 str)) xs
+                                     val ds'' = map (fn x => (L.DVal ((L.PVar x, #2 str), ewild), #2 str)) xs
                                  in
                                      ds'' @ ds'
                                  end
@@ -4022,22 +4032,55 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                                    ([], (env, denv, [])))
                      end)
 
-              | L.DVal (x, co, e) =>
+              | L.DVal (p, e) =>
                 let
-                    val (c', _, gs1) = case co of
-                                           NONE => (cunif env (loc, ktype), ktype, [])
-                                         | SOME c => elabCon (env, denv) c
+                    val ((p', pt), (env', bound)) = elabPat (p, (env, SS.empty))
 
-                    val (e', et, gs2) = elabExp (env, denv) e
+                    val (e', et, gs1) = elabExp (env, denv) e
 
-                    val () = checkCon env e' et c'
+                    val c' = normClassConstraint env et
 
-                    val c' = normClassConstraint env c'
-                    val (env', n) = E.pushENamed env x c'
+                    fun singleVar (p : L.pat) =
+                        case #1 p of
+                            L.PVar x => SOME x
+                          | L.PAnnot (p', _) => singleVar p'
+                          | _ => NONE
                 in
-                    (*prefaces "DVal" [("x", Print.PD.string x),
-                                     ("c'", p_con env c')];*)
-                    ([(L'.DVal (x, n, c', e'), loc)], (env', denv, enD gs1 @ gs2 @ gs))
+                    unifyCons env loc et pt;
+
+                    (case exhaustive (env, et, [p'], loc) of
+                         NONE => ()
+                       | SOME p => if !mayDelay then
+                                       delayedExhaustives := (env, et, [p'], loc) :: !delayedExhaustives
+                                   else
+                                       expError env (Inexhaustive (loc, p)));
+
+                    case singleVar p of
+                        SOME x =>
+                        let
+                            val (env', n) = E.pushENamed env x et
+                        in
+                            ([(L'.DVal (x, n, c', e'), loc)], (env', denv, gs1 @ gs))
+                        end
+                      | NONE =>
+                        let
+                            val (env', n) = E.pushENamed env "$tmp" et
+                            val vars = SS.listItems bound
+                            val (decls, env') =
+                                ListUtil.foldlMap (fn (x, env') =>
+                                                      let
+                                                          val e = (L.ECase ((L.EVar ([], "$tmp", L.Infer), loc),
+                                                                            [(p, (L.EVar ([], x, L.Infer), loc))]), loc)
+                                                          val (e', t, _) = elabExp (env', denv) e
+                                                          val (env', n) = E.pushENamed env' x t
+                                                      in
+                                                          ((L'.DVal (x, n, t, e'), loc),
+                                                           env')
+                                                      end) env' vars
+                        in
+                            ((L'.DVal ("$tmp", n, c', e'), loc) :: decls,
+                             (env', denv, gs1 @ gs))
+                        end
                 end
               | L.DValRec vis =>
                 let
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index fb1a1723..2caa43f8 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -134,6 +134,9 @@ fun oneRun args =
               | "-output" :: s :: rest =>
                 (Settings.setExe (SOME s);
                  doArgs rest)
+              | "-js" :: s :: rest =>
+		(Settings.setOutputJsFile (SOME s);
+		 doArgs rest)
               | "-sql" :: s :: rest =>
                 (Settings.setSql (SOME s);
                  doArgs rest)
diff --git a/src/settings.sig b/src/settings.sig
index 05ab5e23..256a12b5 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -96,6 +96,7 @@ signature SETTINGS = sig
     val isServerOnly : ffi -> bool
 
     (* Which FFI functions may be run in JavaScript?  (JavaScript function names included) *)
+    val setJsModule : string option -> unit
     val setJsFuncs : (ffi * string) list -> unit
     val addJsFunc : ffi * string -> unit
     val jsFunc : ffi -> string option
@@ -303,4 +304,6 @@ signature SETTINGS = sig
     val addJsFile : string (* filename *) -> unit
     val listJsFiles : unit -> {Filename : string, Content : string} list
 
+    val setOutputJsFile : string option (* filename *) -> unit
+    val getOutputJsFile : unit -> string option
 end
diff --git a/src/settings.sml b/src/settings.sml
index 70ea1861..a3263c06 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -346,7 +346,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("asin", "asin"),
                           ("acos", "acos"),
                           ("atan", "atan"),
-                          ("atan2", "atan2"),                           
+                          ("atan2", "atan2"),
                           ("abs", "abs"),
 
                           ("now", "now"),
@@ -395,9 +395,15 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("htmlifySpecialChar", "htmlifySpecialChar"),
                           ("chr", "chr")]
 val jsFuncs = ref jsFuncsBase
-fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
+val jsModule = ref (NONE : string option)
+fun setJsModule m = jsModule := m
+fun jsFuncName f =
+    case !jsModule of
+        SOME m => m ^ "." ^ f
+      | NONE => f
+fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, jsFuncName v)) jsFuncsBase ls
 fun jsFunc x = M.find (!jsFuncs, x)
-fun addJsFunc (k, v) = jsFuncs := M.insert (!jsFuncs, k, v)
+fun addJsFunc (k, v) = jsFuncs := M.insert (!jsFuncs, k, jsFuncName v)
 fun allJsFuncs () = M.listItemsi (!jsFuncs)
 
 datatype pattern_kind = Exact | Prefix
@@ -951,6 +957,10 @@ fun addJsFile LoadFromFilename =
 
 fun listJsFiles () = SM.listItems (!jsFiles)
 
+val jsOutput = ref (NONE : string option)
+fun setOutputJsFile so = jsOutput := so
+fun getOutputJsFile () = !jsOutput
+
 fun reset () =
     (Globals.setResetTime ();
      urlPrefixFull := "/";
@@ -996,6 +1006,7 @@ fun reset () =
      mimeTypes := NONE;
      files := SM.empty;
      jsFiles := SM.empty;
-     filePath := ".")
+     filePath := ".";
+     jsOutput := NONE)
 
 end
diff --git a/src/source.sml b/src/source.sml
index 9971ca93..2d8c1ed3 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -157,7 +157,7 @@ datatype decl' =
          DCon of string * kind option * con
        | DDatatype of (string * string list * (string * con option) list) list
        | DDatatypeImp of string * string list * string
-       | DVal of string * con option * exp
+       | DVal of pat * exp
        | DValRec of (string * con option * exp) list
        | DSgn of string * sgn
        | DStr of string * sgn option * Time.time option * str * bool (* did this module come from the '-root' directive? *)
diff --git a/src/source_print.sml b/src/source_print.sml
index 7b657422..e18a82f9 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -560,9 +560,13 @@ fun p_decl ((d, _) : decl) =
              string "datatype",
              space,
              p_list_sep (string ".") string (ms @ [x'])]
-      | DVal vi => box [string "val",
-                        space,
-                        p_vali vi]
+      | DVal (p, e) => box [string "val",
+                            space,
+                            p_pat p,
+                            space,
+                            string "=",
+                            space,
+                            p_exp e]
       | DValRec vis => box [string "val",
                             space,
                             string "rec",
diff --git a/src/sqlite.sml b/src/sqlite.sml
index c7694cde..a9b6389d 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -850,6 +850,6 @@ val () = addDbms {name = "sqlite",
                   onlyUnion = false,
                   nestedRelops = false,
                   windowFunctions = false,
-                  supportsIsDistinctFrom = true}
+                  supportsIsDistinctFrom = false}
 
 end
diff --git a/src/urweb.grm b/src/urweb.grm
index db5473a6..afebff0a 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -490,7 +490,7 @@ fun patternOut (e : exp) =
  | earga of exp * con -> exp * con
  | eargs of exp * con -> exp * con
  | eargl of exp * con -> exp * con
- | eargl2 of exp * con -> exp * con
+ | eargl2 of bool * (exp * con -> exp * con)
 
  | branch of pat * exp
  | branchs of (pat * exp) list
@@ -622,7 +622,41 @@ decl   : CON SYMBOL cargl2 kopt EQ cexp (let
                 (case dargs of
                      [] => [(DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))]
                    | _ => raise Fail "Arguments specified for imported datatype")
-       | VAL vali                       ([(DVal vali, s (VALleft, valiright))])
+       | VAL pat eargl2 copt EQ eexp    (let
+                                            fun justVar (p : pat) =
+                                                case #1 p of
+                                                    PVar x => SOME x
+                                                  | PAnnot (p', _) => justVar p'
+                                                  | _ => NONE
+
+                                            val loc = s (VALleft, eexpright)
+                                        in
+                                            case justVar pat of
+                                                SOME x =>
+                                                let
+                                                    val t = Option.getOpt (copt, (CWild (KType, loc), loc))
+                                                    val (e, t) = #2 eargl2 (eexp, t)
+                                                    val pat =
+                                                        case #1 t of
+                                                            CWild _ => pat
+                                                          | _ => (PAnnot (pat, t), loc)
+                                                in
+                                                    [(DVal (pat, e), loc)]
+                                                end
+                                              | NONE =>
+                                                let
+                                                    val pat =
+                                                        case copt of
+                                                            SOME t => (PAnnot (pat, t), loc)
+                                                          | _ => pat
+                                                in
+                                                    (if #1 eargl2 then
+                                                         ErrorMsg.errorAt loc "Additional arguments not allowed after pattern"
+                                                     else
+                                                         ());
+                                                    [(DVal (pat, eexp), loc)]
+                                                end
+                                        end)
        | VAL REC valis                  ([(DValRec valis, s (VALleft, valisright))])
        | FUN valis                      ([(DValRec valis, s (FUNleft, valisright))])
 
@@ -695,7 +729,7 @@ vali   : SYMBOL eargl2 copt EQ eexp     (let
                                              val loc = s (SYMBOLleft, eexpright)
                                              val t = Option.getOpt (copt, (CWild (KType, loc), loc))
 
-                                             val (e, t) = eargl2 (eexp, t)
+                                             val (e, t) = #2 eargl2 (eexp, t)
                                          in
                                              (SYMBOL, SOME t, e)
                                          end)
@@ -1279,8 +1313,8 @@ eargs  : earg                           (earg)
 eargl  : eargp eargp                    (eargp1 o eargp2)
        | eargp eargl                    (eargp o eargl)
 
-eargl2 :                                (fn x => x)
-       | eargp eargl2                   (eargp o eargl2)
+eargl2 :                                (false, fn x => x)
+       | eargp eargl2                   (true, eargp o #2 eargl2)
 
 earg   : patS                           (fn (e, t) =>
                                             let