Merge branch 'upstream' into dfsg_clean20160515+dfsg

20 files changed, 211 insertions, 61 deletions

diff --git a/src/c/request.c b/src/c/request.c
index d621aea7..cad84cb2 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -39,7 +39,12 @@ uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls) {
   uw_logger log_error = ls->log_error;
   uw_context ctx = uw_init(id, ls);
   int retries_left = MAX_RETRIES;
-  uw_set_app(ctx, app);
+
+  if (uw_set_app(ctx, app)) {
+    log_error(logger_data, "Unable to initialize request context.  Most likely the limit on number of form inputs has been exceeded.\n");
+    uw_free(ctx);
+    return NULL;
+  }
 
   while (1) {
     failure_kind fk = uw_begin_init(ctx);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index c057688c..c23366fb 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -505,7 +505,7 @@ struct uw_context {
 
   // Sqlcache.
   int numRecording, recordingCapacity;
-  int *recordingOffsets;
+  int *recordingOffsets, *scriptRecordingOffsets;
   uw_Sqlcache_Update *cacheUpdate;
   uw_Sqlcache_Update *cacheUpdateTail;
   uw_Sqlcache_Unlock *cacheUnlock;
@@ -597,6 +597,7 @@ uw_context uw_init(int id, uw_loggers *lg) {
   ctx->numRecording = 0;
   ctx->recordingCapacity = 0;
   ctx->recordingOffsets = malloc(0);
+  ctx->scriptRecordingOffsets = malloc(0);
   ctx->cacheUpdate = NULL;
   ctx->cacheUpdateTail = NULL;
 
@@ -670,6 +671,7 @@ void uw_free(uw_context ctx) {
   free(ctx->output_buffer);
 
   free(ctx->recordingOffsets);
+  free(ctx->scriptRecordingOffsets);
 
   free(ctx);
 }
@@ -1568,6 +1570,10 @@ uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) {
       strcpy(s2, "\\074");
       s2 += 4;
       break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
     default:
       if (isprint((int)c) || c >= 128)
         *s2++ = c;
@@ -1609,6 +1615,10 @@ uw_Basis_string uw_Basis_jsifyChar(uw_context ctx, uw_Basis_char c1) {
     strcpy(s2, "\\074");
     s2 += 4;
     break;
+  case '&':
+    strcpy(s2, "\\046");
+    s2 += 4;
+    break;
   default:
     if (isprint((int)c) || c >= 128)
       *s2++ = c;
@@ -1647,6 +1657,10 @@ uw_Basis_string uw_Basis_jsifyString_ws(uw_context ctx, uw_Basis_string s) {
       strcpy(s2, "\\074");
       s2 += 4;
       break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
     default:
       if (isprint((int)c) || c >= 128)
         *s2++ = c;
@@ -1745,13 +1759,20 @@ void uw_recordingStart(uw_context ctx) {
   if (ctx->numRecording == ctx->recordingCapacity) {
     ++ctx->recordingCapacity;
     ctx->recordingOffsets = realloc(ctx->recordingOffsets, sizeof(int) * ctx->recordingCapacity);
+    ctx->scriptRecordingOffsets = realloc(ctx->scriptRecordingOffsets, sizeof(int) * ctx->recordingCapacity);
   }
   ctx->recordingOffsets[ctx->numRecording] = ctx->page.front - ctx->page.start;
+  ctx->scriptRecordingOffsets[ctx->numRecording] = ctx->script.front - ctx->script.start;
   ++ctx->numRecording;
 }
 
 char *uw_recordingRead(uw_context ctx) {
-  char *recording = ctx->page.start + ctx->recordingOffsets[--ctx->numRecording];
+  char *recording = ctx->page.start + ctx->recordingOffsets[ctx->numRecording-1];
+  return strdup(recording);
+}
+
+char *uw_recordingReadScript(uw_context ctx) {
+  char *recording = ctx->script.start + ctx->scriptRecordingOffsets[--ctx->numRecording];
   return strdup(recording);
 }
 
@@ -3814,6 +3835,34 @@ uw_Basis_string uw_Basis_checkEnvVar(uw_context ctx, uw_Basis_string s) {
     return NULL;
 }
 
+static int meta_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalpha((int)*s) && *s != '-')
+      return 0;
+
+  return 1;
+}
+
+uw_Basis_string uw_Basis_blessMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    uw_error(ctx, FATAL, "Meta name \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed meta name %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    return NULL;
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    return NULL;
+}
+
 uw_Basis_string uw_Basis_getHeader(uw_context ctx, uw_Basis_string name) {
   return uw_Basis_requestHeader(ctx, name);
 }
@@ -3915,9 +3964,18 @@ static char *old_headers(uw_context ctx) {
   if (uw_buffer_used(&ctx->outHeaders) == 0)
     return NULL;
   else {
-    char *s = strchr(ctx->outHeaders.start, '\n');
+    char *s;
+    int is_good;
+
+    if (strncasecmp(ctx->outHeaders.start, "Content-type: ", 14)) {
+      s = strchr(ctx->outHeaders.start, '\n');
+      is_good = !strncasecmp(s+1, "Content-type: ", 14);
+    } else {
+      s = ctx->outHeaders.start;
+      is_good = 1;
+    }
 
-    if (s == NULL || strncasecmp(s+1, "Content-type: ", 14))
+    if (!is_good)
       return NULL;
     else {
       s = strchr(s+15, '\n');
@@ -4566,6 +4624,7 @@ static void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) {
   if (value) {
     free(value->result);
     free(value->output);
+    free(value->scriptOutput);
     free(value);
   }
 }
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 2471ce59..b2c85a54 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3468,6 +3468,9 @@ fun p_file env (ds, ps) =
              makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()),
              newline,
 
+             makeChecker ("uw_check_meta", Settings.getMetaRules ()),
+             newline,
+
              string "extern void uw_sign(const char *in, char *out);",
              newline,
              string "extern int uw_hash_blocksize;",
@@ -3652,7 +3655,7 @@ fun p_file env (ds, ps) =
                          "uw_client_init", "uw_initializer", "uw_expunger",
                          "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close",
                          "uw_handle",
-                         "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar",
+                         "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar", "uw_check_meta",
                          case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics",
                          "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\"",
                          if Settings.getIsHtml5 () then "1" else "0"],
diff --git a/src/compiler.sig b/src/compiler.sig
index c154240a..a4b3e562 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -55,6 +55,7 @@ signature COMPILER = sig
          filterRequest : Settings.rule list,
          filterResponse : Settings.rule list,
          filterEnv : Settings.rule list,
+         filterMeta : Settings.rule list,
          protocol : string option,
          dbms : string option,
          sigFile : string option,
diff --git a/src/compiler.sml b/src/compiler.sml
index 7580c5e4..76743fad 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -59,6 +59,7 @@ type job = {
      filterRequest : Settings.rule list,
      filterResponse : Settings.rule list,
      filterEnv : Settings.rule list,
+     filterMeta : Settings.rule list,
      protocol : string option,
      dbms : string option,
      sigFile : string option,
@@ -374,6 +375,7 @@ fun institutionalizeJob (job : job) =
      Settings.setRequestHeaderRules (#filterRequest job);
      Settings.setResponseHeaderRules (#filterResponse job);
      Settings.setEnvVarRules (#filterEnv job);
+     Settings.setMetaRules (#filterMeta job);
      Option.app Settings.setProtocol (#protocol job);
      Option.app Settings.setDbms (#dbms job);
      Settings.setSafeGets (#safeGets job);
@@ -453,6 +455,7 @@ fun parseUrp' accLibs fname =
                         filterRequest = [],
                         filterResponse = [],
                         filterEnv = [],
+                        filterMeta = [],
                         protocol = NONE,
                         dbms = NONE,
                         sigFile = NONE,
@@ -574,6 +577,7 @@ fun parseUrp' accLibs fname =
                      val request = ref []
                      val response = ref []
                      val env = ref []
+                     val meta = ref []
                      val libs = ref []
                      val protocol = ref NONE
                      val dbms = ref NONE
@@ -610,6 +614,7 @@ fun parseUrp' accLibs fname =
                                  filterRequest = rev (!request),
                                  filterResponse = rev (!response),
                                  filterEnv = rev (!env),
+                                 filterMeta = rev (!meta),
                                  sources = sources,
                                  protocol = !protocol,
                                  dbms = !dbms,
@@ -667,6 +672,7 @@ fun parseUrp' accLibs fname =
                                  filterRequest = #filterRequest old @ #filterRequest new,
                                  filterResponse = #filterResponse old @ #filterResponse new,
                                  filterEnv = #filterEnv old @ #filterEnv new,
+                                 filterMeta = #filterMeta old @ #filterMeta new,
                                  sources = #sources new
                                            @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
                                                          (#sources old),
@@ -710,6 +716,7 @@ fun parseUrp' accLibs fname =
                            | "requestHeader" => request
                            | "responseHeader" => response
                            | "env" => env
+                           | "meta" => meta
                            | _ => (ErrorMsg.error "Bad filter kind";
                                    url)
 
diff --git a/src/demo.sml b/src/demo.sml
index 17de80ee..0d9f0f4f 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -118,6 +118,7 @@ fun make' {prefix, dirname, guided} =
             filterRequest = #filterRequest combined @ #filterRequest urp,
             filterResponse = #filterResponse combined @ #filterResponse urp,
             filterEnv = #filterEnv combined @ #filterEnv urp,
+            filterMeta = #filterMeta combined @ #filterMeta urp,
             protocol = mergeWith #2 (#protocol combined, #protocol urp),
             dbms = mergeWith #2 (#dbms combined, #dbms urp),
             sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
@@ -318,12 +319,13 @@ fun make' {prefix, dirname, guided} =
                                                              Posix.FileSys.ST.mtime htmlSt)
                                                  end handle OS.SysErr _ => true
 
-                                             val cmd = "emacs --eval \"(progn "
+                                             val cmd = "emacs -no-init-file --eval \"(progn "
                                                        ^ "(global-font-lock-mode t) "
                                                        ^ "(add-to-list 'load-path \\\""
                                                        ^ !Settings.configSitelisp
                                                        ^ "/\\\") "
                                                        ^ "(load \\\"urweb-mode-startup\\\") "
+                                                       ^ "(load \\\"htmlize\\\") "
                                                        ^ "(urweb-mode) "
                                                        ^ "(find-file \\\""
                                                        ^ src
diff --git a/src/lru_cache.sml b/src/lru_cache.sml
index 81000458..f582bf6f 100644
--- a/src/lru_cache.sml
+++ b/src/lru_cache.sml
@@ -116,6 +116,8 @@ fun setupQuery {index, params} =
              newline,*)
              string "    uw_write(ctx, v->output);",
              newline,
+             string "    uw_write_script(ctx, v->scriptOutput);",
+             newline,
              string "    return v->result;",
              newline,
              string "  } else {",
@@ -148,6 +150,8 @@ fun setupQuery {index, params} =
              newline,
              string "  v->output = uw_recordingRead(ctx);",
              newline,
+             string "  v->scriptOutput = uw_recordingReadScript(ctx);",
+             newline,
              (*string ("  puts(\"SQLCACHE: stored " ^ i ^ ".\");"),
              newline,*)
              string ("  uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"),
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 186f6c62..40b865b0 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -539,6 +539,17 @@ fun exp e =
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMeta'");
+         se)
+      | EFfiApp ("Basis", "checkMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
 
       | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) =>
         let
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 540d396b..5bcb6f57 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -44,6 +44,13 @@ structure SS = BinarySetFn(struct
                             val compare = String.compare
                             end)
 
+structure SLS = BinarySetFn(struct
+                             type ord_key = string list
+                             val compare = Order.joinL String.compare
+                             end)
+
+
+
 fun simpleTypeImpure tsyms =
     U.Typ.exists (fn TFun _ => true
                    | TDatatype (n, _) => IS.member (tsyms, n)
@@ -602,28 +609,35 @@ fun reduce' (file : file) =
                                 ERecord _ => true
                               | _ => false
 
+                        fun prefixFrom i (e : exp) =
+                            case #1 e of
+                                ERel i' => if i' = i then SOME [] else NONE
+                              | EField (e', s) =>
+                                (case prefixFrom i e' of
+                                     NONE => NONE
+                                   | SOME ss => SOME (ss @ [s]))
+                              | _ => NONE
+
                         fun whichProj i (e : exp) =
                             case #1 e of
-                                EPrim _ => SOME SS.empty
-                              | ERel i' => if i' = i then NONE else SOME SS.empty
-                              | ENamed _ => SOME SS.empty
-                              | ECon (_, _, NONE) => SOME SS.empty
+                                EPrim _ => SOME SLS.empty
+                              | ERel i' => if i' = i then NONE else SOME SLS.empty
+                              | ENamed _ => SOME SLS.empty
+                              | ECon (_, _, NONE) => SOME SLS.empty
                               | ECon (_, _, SOME e') => whichProj i e'
-                              | ENone _ => SOME SS.empty
+                              | ENone _ => SOME SLS.empty
                               | ESome (_, e') => whichProj i e'
-                              | EFfi _ => SOME SS.empty
+                              | EFfi _ => SOME SLS.empty
                               | EFfiApp (_, _, es) => whichProjs i (map #1 es)
                               | EApp (e1, e2) => whichProjs i [e1, e2]
                               | EAbs (_, _, _, e) => whichProj (i + 1) e
                               | EUnop (_, e1) => whichProj i e1
                               | EBinop (_, _, e1, e2) => whichProjs i [e1, e2]
                               | ERecord xets => whichProjs i (map #2 xets)
-                              | EField ((ERel i', _), s) =>
-                                if i' = i then
-                                    SOME (SS.singleton s)
-                                else
-                                    SOME SS.empty
-                              | EField (e1, _) => whichProj i e1
+                              | EField (e1, s) =>
+                                (case prefixFrom i e1 of
+                                     NONE => SOME SLS.empty
+                                   | SOME ss => SOME (SLS.singleton (ss @ [s])))
                               | ECase (e1, pes, _) =>
                                 whichProjs' i ((0, e1)
                                                :: map (fn (p, e) => (patBinds p, e)) pes)
@@ -656,12 +670,12 @@ fun reduce' (file : file) =
 
                         and whichProjs' i es =
                             case es of
-                                [] => SOME SS.empty
+                                [] => SOME SLS.empty
                               | (n, e) :: es' =>
                                 case (whichProj (i + n) e, whichProjs' i es') of
                                     (SOME m1, SOME m2) =>
-                                    if SS.isEmpty (SS.intersection (m1, m2)) then
-                                        SOME (SS.union (m1, m2))
+                                    if SLS.isEmpty (SLS.intersection (m1, m2)) then
+                                        SOME (SLS.union (m1, m2))
                                     else
                                         NONE
                                   | _ => NONE
diff --git a/src/monoize.sml b/src/monoize.sml
index 6715290f..86f2b4a5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -234,6 +234,7 @@ fun monoType env =
                   | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "meta") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc)
 
@@ -2326,24 +2327,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 val body = case #1 arg1 of
                                L.CApp ((L.CFfi ("Basis", "option"), _), _) =>
-                                (L'.ECase ((L'.ERel 2, loc),
-                                           [((L'.PPrim (Prim.String (Prim.Normal, "=")), loc),
-                                             strcat [str "((",
-                                                     (L'.ERel 1, loc),
-                                                     str " ",
-                                                     (L'.ERel 2, loc),
-                                                     str " ",
-                                                     (L'.ERel 0, loc),
-                                                     str ") OR ((",
-                                                     (L'.ERel 1, loc),
-                                                     str ") IS NULL AND (",
-                                                     (L'.ERel 0, loc),
-                                                     str ") IS NULL))"]),
-                                            ((L'.PVar ("_", s), loc),
-                                             default 1)],
-                                           {disc = s,
-                                            result = s}), loc)
-                             | _ => default 0
+                               (L'.ECase ((L'.ERel 2, loc),
+                                          [((L'.PPrim (Prim.String (Prim.Normal, "=")), loc),
+                                            if #supportsIsDistinctFrom (Settings.currentDbms ()) then
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " IS NOT DISTINCT FROM ",
+                                                        (L'.ERel 0, loc),
+                                                        str "))"]
+                                            else
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " ",
+                                                        (L'.ERel 2, loc),
+                                                        str " ",
+                                                        (L'.ERel 0, loc),
+                                                        str ") OR ((",
+                                                        (L'.ERel 1, loc),
+                                                        str ") IS NULL AND (",
+                                                        (L'.ERel 0, loc),
+                                                        str ") IS NULL))"]),
+                                           ((L'.PVar ("_", s), loc),
+                                            default 1)],
+                                          {disc = s,
+                                           result = s}), loc)
+                               | _ => default 0
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
diff --git a/src/mysql.sml b/src/mysql.sml
index 692be0a2..539428f6 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1608,6 +1608,7 @@ val () = addDbms {name = "mysql",
                   falseString = "FALSE",
                   onlyUnion = true,
                   nestedRelops = false,
-                  windowFunctions = false}
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = true}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index 1c95f414..ddfe0ad6 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -1145,7 +1145,8 @@ val () = addDbms {name = "postgres",
                   falseString = "FALSE",
                   onlyUnion = false,
                   nestedRelops = true,
-                  windowFunctions = true}
+                  windowFunctions = true,
+                  supportsIsDistinctFrom = true}
 
 val () = setDbms "postgres"
 
diff --git a/src/settings.sig b/src/settings.sig
index c75f12a3..dd135bda 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -133,6 +133,10 @@ signature SETTINGS = sig
     val getEnvVarRules : unit -> rule list
     val checkEnvVar : string -> bool
 
+    val setMetaRules : rule list -> unit
+    val getMetaRules : unit -> rule list
+    val checkMeta : string -> bool
+
     (* Web protocols that generated programs may speak *)
     type protocol = {
         name : string,       (* Call it this on the command line *)
@@ -213,7 +217,8 @@ signature SETTINGS = sig
          falseString : string,
          onlyUnion : bool,
          nestedRelops : bool,
-         windowFunctions : bool
+         windowFunctions : bool,
+         supportsIsDistinctFrom : bool
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 38ea30fc..85cab207 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -460,18 +460,21 @@ val mime = ref ([] : rule list)
 val request = ref ([] : rule list)
 val response = ref ([] : rule list)
 val env = ref ([] : rule list)
+val meta = ref ([] : rule list)
 
 fun setUrlRules ls = url := ls
 fun setMimeRules ls = mime := ls
 fun setRequestHeaderRules ls = request := ls
 fun setResponseHeaderRules ls = response := ls
 fun setEnvVarRules ls = env := ls
+fun setMetaRules ls = meta := ls
 
 fun getUrlRules () = !url
 fun getMimeRules () = !mime
 fun getRequestHeaderRules () = !request
 fun getResponseHeaderRules () = !response
 fun getEnvVarRules () = !env
+fun getMetaRules () = !meta
 
 fun check f rules s =
     let
@@ -500,11 +503,13 @@ val checkUrl = check (fn _ => true) url
 
 val validMime = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"." orelse ch = #"+")
 val validEnv = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #".")
+val validMeta = CharVector.all (fn ch => Char.isAlpha ch orelse ch = #"-")
 
 val checkMime = check validMime mime
 val checkRequestHeader = check validMime request
 val checkResponseHeader = check validMime response
 val checkEnvVar = check validEnv env
+val checkMeta = check validMeta meta
 
 
 type protocol = {
@@ -621,7 +626,8 @@ type dbms = {
      falseString : string,
      onlyUnion : bool,
      nestedRelops : bool,
-     windowFunctions: bool
+     windowFunctions: bool,
+     supportsIsDistinctFrom : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -653,7 +659,8 @@ val curDb = ref ({name = "",
                   falseString = "",
                   onlyUnion = false,
                   nestedRelops = false,
-                  windowFunctions = false} : dbms)
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
@@ -950,6 +957,7 @@ fun reset () =
      request := [];
      response := [];
      env := [];
+     meta := [];
      debug := false;
      dbstring := NONE;
      exe := NONE;
diff --git a/src/sources b/src/sources
index 8bf80bc6..1a09e7e8 100644
--- a/src/sources
+++ b/src/sources
@@ -186,9 +186,6 @@ $(SRC)/cache.sml
 $(SRC)/toy_cache.sml
 $(SRC)/lru_cache.sml
 
-$(SRC)/sqlcache.sig
-$(SRC)/sqlcache.sml
-
 $(SRC)/monoize.sig
 $(SRC)/monoize.sml
 
@@ -210,6 +207,9 @@ $(SRC)/fuse.sml
 $(SRC)/iflow.sig
 $(SRC)/iflow.sml
 
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
 $(SRC)/name_js.sig
 $(SRC)/name_js.sml
 
diff --git a/src/sql.sml b/src/sql.sml
index dfe2f968..409e205c 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -193,7 +193,7 @@ val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >=
                                         SOME (str (Char.toUpper (String.sub (s, 3)))
                                               ^ String.extract (s, 4, NONE))
                                     else
-                                        NONE)
+                                        SOME s)
 
 val field = wrap (follow (opt (follow t_ident (const ".")))
                          uw_ident)
@@ -221,6 +221,7 @@ datatype sqexp =
 fun cmp s r = wrap (const s) (fn () => RCmp r)
 
 val sqbrel = altL [cmp "=" Eq,
+                   cmp "IS NOT DISTINCT FROM" Eq,
                    cmp "<>" Ne,
                    cmp "<=" Le,
                    cmp "<" Lt,
@@ -334,11 +335,12 @@ fun sqexp chs =
     (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
            wrap (const "TRUE") (fn () => SqTrue),
            wrap (const "FALSE") (fn () => SqFalse),
+           wrap (follow (const "NULL::") ident) (fn ((), _) => Null),
            wrap (const "NULL") (fn () => Null),
-           wrap field Field,
-           wrap uw_ident Computed,
            wrap known SqKnown,
            wrap func SqFunc,
+           wrap field Field,
+           wrap uw_ident Computed,
            wrap (arithmetic sqexp) (fn _ => Unmodeled),
            wrap unmodeled (fn () => Unmodeled),
            wrap (if !sqlcacheMode then sqlifySqlcache else sqlify) Inj,
@@ -402,6 +404,11 @@ val orderby = log "orderby"
                                           (opt (ws (const "DESC"))))))
                     ignore)
 
+val groupby = log "groupby"
+                  (wrap (follow (ws (const "GROUP BY "))
+                                (list sqexp))
+                        ignore)
+
 val jtype = altL [wrap (const "JOIN") (fn () => Inner),
                   wrap (const "LEFT JOIN") (fn () => Left),
                   wrap (const "RIGHT JOIN") (fn () => Right),
@@ -444,7 +451,7 @@ and query chs = log "query"
                                                                   (follow query (const "))")))))
                                           (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
                                     (wrap query1 Query1))
-                               (opt orderby))
+                               (follow (opt groupby) (opt orderby)))
                           #1)
                     chs
 
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 75a17e48..83a264fd 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -1370,9 +1370,9 @@ fun cacheExp (env, exp', invalInfo, state : state) =
                                  (case arg of
                                       AsIs exp => SOME exp
                                     | Urlify exp =>
-                                      typOfExp env exp
+                                      (typOfExp env exp)
                                       <\obind\>
-                                       (fn typ => (MonoFooify.urlify env (exp, typ))))
+                                       (fn typ => MonoFooify.urlify env (exp, typ)))
                                  <\obind\>
                                   (fn arg' => SOME (arg' :: args'))))
                         (SOME [])
@@ -1588,18 +1588,19 @@ fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state
                 val inval =
                     case Sql.parse Sql.dml dmlText of
                         SOME dmlParsed =>
-                        SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of
+                        SOME (map (fn i => case IM.find (indexToInvalInfo, i) of
                                                 SOME invalInfo =>
                                                 (i, invalidations (invalInfo, dmlParsed))
                                               (* TODO: fail more gracefully. *)
                                               (* This probably means invalidating everything.... *)
-                                              | NONE => raise Fail "Sqlcache: addFlushing (a)"))
+                                              | NONE => raise Fail "Sqlcache: addFlushing (a)")
                                   (SIMM.findList (tableToIndices, tableOfDml dmlParsed)))
                       | NONE => NONE
             in
                 case inval of
                     (* TODO: fail more gracefully. *)
-                    NONE => raise Fail "Sqlcache: addFlushing (b)"
+                    NONE => (Print.preface ("DML", MonoPrint.p_exp MonoEnv.empty dmlText);
+                             raise Fail "Sqlcache: addFlushing (b)")
                   | SOME invs => sequence (flushes invs @ [dmlExp])
             end
           | e' => e'
@@ -1723,8 +1724,9 @@ fun go file =
         (* Important that this happens after [MonoFooify.urlify] calls! *)
         val fmDecls = MonoFooify.getNewFmDecls ()
         val () = Sql.sqlcacheMode := false
+        val file = insertAfterDatatypes (file, rev fmDecls)
     in
-        insertAfterDatatypes (file, rev fmDecls)
+        MonoReduce.reduce file
     end
 
 end
diff --git a/src/sqlite.sml b/src/sqlite.sml
index a1095709..c7694cde 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -849,6 +849,7 @@ val () = addDbms {name = "sqlite",
                   falseString = "0",
                   onlyUnion = false,
                   nestedRelops = false,
-                  windowFunctions = false}
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = true}
 
 end
diff --git a/src/urweb.grm b/src/urweb.grm
index 0f499e20..40101056 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2014, Adam Chlipala
+(* Copyright (c) 2008-2016, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -573,7 +573,7 @@ fun patternOut (e : exp) =
 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL
 %right OR
 %right CAND
-%nonassoc EQ NE LT LE GT GE IS
+%nonassoc EQ NE LT LE GT GE IS LIKE
 %right ARROW
 
 %left REVAPP
@@ -1780,6 +1780,16 @@ attr   : SYMBOL EQ attrv                (case SYMBOL of
                                                                      (EApp ((EVar (["Basis"], "bless", Infer), loc),
                                                                             attrv), loc)
                                                                  end
+                                                             else if sym = "Nam"
+                                                                andalso (case #1 attrv of
+                                                                             EPrim _ => true
+                                                                           | _ => false) then
+                                                                 let
+                                                                     val loc = s (attrvleft, attrvright)
+                                                                 in
+                                                                     (EApp ((EVar (["Basis"], "blessMeta", Infer), loc),
+                                                                            attrv), loc)
+                                                                 end
                                                              else
                                                                  attrv)
                                                  end)
diff --git a/src/urweb.lex b/src/urweb.lex
index ca45eb6d..368b9f1b 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -224,6 +224,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 <STRING,CHAR> "\\\""  => (str := #"\"" :: !str; continue());
 <STRING,CHAR> "\\'"   => (str := #"'" :: !str; continue());
 <STRING,CHAR> "\\n"   => (str := #"\n" :: !str; continue());
+<STRING,CHAR> "\\r"   => (str := #"\r" :: !str; continue());
 <STRING,CHAR> "\\\\"  => (str := #"\\" :: !str; continue());
 <STRING,CHAR> "\\t"   => (str := #"\t" :: !str; continue());
 <STRING,CHAR> "\n"    => (newline yypos;