Merge remote-tracking branch 'origin/master' into typeOf

22 files changed, 504 insertions, 355 deletions

diff --git a/src/c/Makefile.am b/src/c/Makefile.am
index 95582793..ff4b6eaf 100644
--- a/src/c/Makefile.am
+++ b/src/c/Makefile.am
@@ -11,7 +11,7 @@ AM_CFLAGS = -Wall -Wunused-parameter -Werror -Wno-format-security -Wno-deprecate
 liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS) \
 	-export-symbols-regex '^(client_pruner|pthread_create_big|strcmp_nullsafe|uw_.*)' \
 	-version-info 1:0:0
-liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS) $(ICU_LIBS) -licui18n -licuuc -licudata
+liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS) $(ICU_LIBS) -licui18n -licuuc -licudata -licuio
 liburweb_http_la_LIBADD = liburweb.la
 liburweb_http_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)' \
 	-version-info 1:0:0
diff --git a/src/c/http.c b/src/c/http.c
index 68c16e0b..c1fccf4a 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -65,6 +65,7 @@ static void log_error(void *data, const char *fmt, ...) {
   va_start(ap, fmt);
 
   vfprintf(stderr, fmt, ap);
+  fflush(stderr);
 }
 
 static void log_debug(void *data, const char *fmt, ...) {
@@ -75,6 +76,7 @@ static void log_debug(void *data, const char *fmt, ...) {
     va_start(ap, fmt);
 
     vprintf(fmt, ap);
+    fflush(stdout);
   }
 }
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index b820354f..a01b4aae 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -21,6 +21,7 @@
 #include <pthread.h>
 
 #include <unicode/utf8.h>
+#include <unicode/ustring.h>
 #include <unicode/uchar.h>
 
 #include "types.h"
@@ -2344,10 +2345,23 @@ char *uw_Basis_htmlifySpecialChar(uw_context ctx, uw_Basis_char ch) {
 
 uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, uw_Basis_char ch) {
   unsigned int n = ch;
-  int len;
+  int len = 0;
 
   uw_check(ctx, INTS_MAX+3);
-  len = sprintf(ctx->page.front, "&#%u;", n);
+
+  if(uw_Basis_isprint(ctx, ch)) {
+
+    int32_t len_written = 0;
+    UErrorCode err = U_ZERO_ERROR;
+
+    u_strToUTF8(ctx->page.front, 5, &len_written, (const UChar*)&ch, 1, &err);
+    len = len_written;
+  }
+
+  // either it's a non-printable character, or we failed to convert to UTF-8
+  if(len == 0) {
+    len = sprintf(ctx->page.front, "&#%u;", n);
+  }
   ctx->page.front += len;
 
   return uw_unit_v;
@@ -2459,7 +2473,7 @@ uw_unit uw_Basis_htmlifyString_w(uw_context ctx, uw_Basis_string s) {
     else {
       uw_Basis_htmlifySpecialChar_w(ctx, c1);
     }    
-  }  
+  }
 
   return uw_unit_v;
 }
@@ -2710,6 +2724,18 @@ uw_Basis_string uw_Basis_str1(uw_context ctx, uw_Basis_char ch) {
   return r; 
 }
 
+uw_Basis_string uw_Basis_ofUnicode(uw_context ctx, uw_Basis_int n) {
+  UChar buf16[] = {n};
+  uw_Basis_string out = uw_malloc(ctx, 3);
+  int32_t outLen;
+  UErrorCode pErrorCode = 0;
+
+  if (u_strToUTF8(out, 3, &outLen, buf16, 1, &pErrorCode) == NULL || outLen == 0)
+    uw_error(ctx, FATAL, "Bad Unicode string to unescape (error %s)", u_errorName(pErrorCode));
+
+  return out;
+}
+
 uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) {
   int len = strlen(s1) + 1;
   char *s;
@@ -4915,13 +4941,13 @@ uw_Basis_postField *uw_Basis_firstFormField(uw_context ctx, uw_Basis_string s) {
 
   f = uw_malloc(ctx, sizeof(uw_Basis_postField));
   unurl = s;
-  f->name = uw_Basis_unurlifyString(ctx, &unurl);
+  f->name = uw_Basis_unurlifyString_fromClient(ctx, &unurl);
   s = strchr(s, 0);
   if (!s)
     uw_error(ctx, FATAL, "firstFormField: Missing null terminator");
   ++s;
   unurl = s;
-  f->value = uw_Basis_unurlifyString(ctx, &unurl);
+  f->value = uw_Basis_unurlifyString_fromClient(ctx, &unurl);
   s = strchr(s, 0);
   if (!s)
     uw_error(ctx, FATAL, "firstFormField: Missing null terminator");
diff --git a/src/cjr.sml b/src/cjr.sml
index e582e6ae..9b154428 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -115,7 +115,7 @@ datatype decl' =
        | DTable of string * (string * typ) list * string * (string * string) list
        | DSequence of string
        | DView of string * (string * typ) list * string
-       | DDatabase of {name : string, expunge : int, initialize : int}
+       | DDatabase of {name : string, expunge : int, initialize : int, usesSimilar : bool}
        | DPreparedStatements of (string * int) list
 
        | DJavaScript of string
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5dcfbe89..70ebdf43 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1014,52 +1014,39 @@ fun urlify env t =
     let
         fun urlify' level (t as (_, loc)) =
             case #1 t of
-                TFfi ("Basis", "unit") => box []
+                TFfi ("Basis", "unit") => box [string "uw_Basis_urlifyString_w(ctx, \"\");",
+                                               newline]
               | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
                                             ^ "_w(ctx, it" ^ Int.toString level ^ ");"),
                                     newline]
 
-              | TRecord 0 => box []
+              | TRecord 0 => box [string "uw_Basis_urlifyString_w(ctx, \"\");",
+                                  newline]
               | TRecord i =>
                 let
-                    fun empty (t, _) =
-                        case t of
-                            TFfi ("Basis", "unit") => true
-                          | TRecord 0 => true
-                          | TRecord j =>
-                            List.all (fn (_, t) => empty t) (E.lookupStruct env j)
-                          | _ => false
-
                     val xts = E.lookupStruct env i
 
                     val (blocks, _) = foldl
                                       (fn ((x, t), (blocks, printingSinceLastSlash)) =>
-                                          let
-                                              val thisEmpty = empty t
-                                          in
-                                              if thisEmpty then
-                                                  (blocks, printingSinceLastSlash)
-                                              else
-                                                  (box [string "{",
-                                                        newline,
-                                                        p_typ env t,
-                                                        space,
-                                                        string ("it" ^ Int.toString (level + 1)),
-                                                        space,
-                                                        string "=",
-                                                        space,
-                                                        string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
-                                                        newline,
-                                                        box (if printingSinceLastSlash then
-                                                                 [string "uw_write(ctx, \"/\");",
-                                                                  newline]
-                                                             else
-                                                                 []),
-                                                        urlify' (level + 1) t,
-                                                        string "}",
-                                                        newline] :: blocks,
-                                                   true)
-                                          end)
+                                          (box [string "{",
+                                                newline,
+                                                p_typ env t,
+                                                space,
+                                                string ("it" ^ Int.toString (level + 1)),
+                                                space,
+                                                string "=",
+                                                space,
+                                                string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
+                                                newline,
+                                                box (if printingSinceLastSlash then
+                                                         [string "uw_write(ctx, \"/\");",
+                                                          newline]
+                                                     else
+                                                         []),
+                                                urlify' (level + 1) t,
+                                                string "}",
+                                                newline] :: blocks,
+                                           true))
                                       ([], false) xts
                 in
                     box (rev blocks)
@@ -3243,10 +3230,11 @@ fun p_file env (ds, ps) =
 
         val _ = foldl (fn (d, env) =>
                           ((case #1 d of
-                                DDatabase {name = x, expunge = y, initialize = z} => (hasDb := true;
-                                                                                      dbstring := x;
-                                                                                      expunge := y;
-                                                                                      initialize := z)
+                                DDatabase {name = x, expunge = y, initialize = z, ...} =>
+                                (hasDb := true;
+                                 dbstring := x;
+                                 expunge := y;
+                                 initialize := z)
                               | DJavaScript _ => hasJs := true
                               | DTable (s, xts, _, _) => tables := (s, map (fn (x, t) =>
                                                                                (x, sql_type_in env t)) xts) :: !tables
@@ -3766,6 +3754,8 @@ fun declaresAsForeignKey xs s =
              
 fun p_sql env (ds, _) =
     let
+        val usesSimilar = ref false
+
         val (pps, _) = ListUtil.foldlMap
                        (fn (dAll as (d, _), env) =>
                            let
@@ -3850,6 +3840,9 @@ fun p_sql env (ds, _) =
                                                  string ";",
                                                  newline,
                                                  newline]
+                                          | DDatabase {usesSimilar = s, ...} =>
+                                            (usesSimilar := s;
+                                             box [])
                                           | _ => box []
                            in
                                (pp, E.declBinds env dAll)
@@ -3862,6 +3855,13 @@ fun p_sql env (ds, _) =
                                 NONE => (ErrorMsg.error "Using file cache with database that doesn't support SHA512";
                                          [])
                               | SOME r => [string (#InitializeDb r), newline, newline])
+             @ (if !usesSimilar then
+                    case #supportsSimilar (Settings.currentDbms ()) of
+                        NONE => (ErrorMsg.error "Using SIMILAR with database that doesn't support it";
+                                 [])
+                      | SOME r => [string (#InitializeDb r), newline, newline]
+                else
+                    [])
              @ string (#sqlPrefix (Settings.currentDbms ())) :: pps)
     end
 
diff --git a/src/compiler.sml b/src/compiler.sml
index 0aba3a40..fab939f9 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -745,7 +745,7 @@ fun parseUrp' accLibs fname =
                            | "relation" => Settings.Relation
                            | "cookie" => Settings.Cookie
                            | "style" => Settings.Style
-                           | _ => (ErrorMsg.error "Bad path kind spec";
+                           | _ => (ErrorMsg.error ("Bad path kind spec \"" ^ s ^ "\"");
                                    Settings.Any)
 
                      fun parsePattern s =
@@ -1610,9 +1610,13 @@ fun compileC {cname, oname, ename, libs, profile, debug, linker, link = link'} =
         val proto = Settings.currentProtocol ()
 
         val lib = if Settings.getBootLinking () then
-                      !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a " ^ !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata"
+                      !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^
+                      !Settings.configLib ^ "/liburweb.a " ^
+                      !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata -licuio"
                   else if Settings.getStaticLinking () then
-                      " -static " ^ !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a " ^ !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata"
+                      " -static " ^ !Settings.configLib ^ "/" ^ #linkStatic
+                      proto ^ " " ^ !Settings.configLib ^ "/liburweb.a " ^
+                      !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata -licuio"
                   else
                       "-L" ^ !Settings.configLib ^ " " ^ #linkDynamic proto ^ " -lurweb"
 
diff --git a/src/elab_err.sig b/src/elab_err.sig
index acf137df..fc80fcac 100644
--- a/src/elab_err.sig
+++ b/src/elab_err.sig
@@ -29,6 +29,7 @@ signature ELAB_ERR = sig
 
     datatype kind_error =
              UnboundKind of ErrorMsg.span * string
+           | KDisallowedWildcard of ErrorMsg.span
 
     val kindError : ElabEnv.env -> kind_error -> unit
 
@@ -47,6 +48,7 @@ signature ELAB_ERR = sig
            | DuplicateField of ErrorMsg.span * string
            | ProjBounds of Elab.con * int
            | ProjMismatch of Elab.con * Elab.kind
+           | CDisallowedWildcard of ErrorMsg.span
 
     val conError : ElabEnv.env -> con_error -> unit
 
diff --git a/src/elab_err.sml b/src/elab_err.sml
index 385caca3..bbe1c160 100644
--- a/src/elab_err.sml
+++ b/src/elab_err.sml
@@ -40,11 +40,14 @@ val p_kind = P.p_kind
              
 datatype kind_error =
          UnboundKind of ErrorMsg.span * string
+       | KDisallowedWildcard of ErrorMsg.span
 
 fun kindError env err =
     case err of
         UnboundKind (loc, s) =>
         ErrorMsg.errorAt loc ("Unbound kind variable " ^ s)
+      | KDisallowedWildcard loc =>
+        ErrorMsg.errorAt loc "Wildcard not allowed in signature"
 
 datatype kunify_error =
          KOccursCheckFailed of kind * kind
@@ -76,6 +79,7 @@ datatype con_error =
        | DuplicateField of ErrorMsg.span * string
        | ProjBounds of con * int
        | ProjMismatch of con * kind
+       | CDisallowedWildcard of ErrorMsg.span
 
 fun conError env err =
     case err of
@@ -101,6 +105,8 @@ fun conError env err =
         (ErrorMsg.errorAt (#2 c) "Projection from non-tuple constructor";
          eprefaces' [("Constructor", p_con env c),
                      ("Kind", p_kind env k)])
+      | CDisallowedWildcard loc =>
+        ErrorMsg.errorAt loc "Wildcard not allowed in signature"
 
 datatype cunify_error =
          CKind of kind * kind * E.env * kunify_error
diff --git a/src/elab_util.sml b/src/elab_util.sml
index 0cdb9cc1..aa5bc6a4 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -541,11 +541,13 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
         and mfed ctx (dAll as (d, loc)) =
             case d of
                 EDVal (p, t, e) =>
-                S.bind2 (mfc ctx t,
-                         fn t' =>
-                            S.map2 (mfe ctx e,
-                                 fn e' =>
-                                    (EDVal (p, t', e'), loc)))
+                S.bind2 (mfp ctx p,
+                         fn p' =>
+                            S.bind2 (mfc ctx t,
+                                     fn t' =>
+                                        S.map2 (mfe ctx e,
+                                                fn e' =>
+                                                   (EDVal (p', t', e'), loc))))
               | EDValRec vis =>
                 let
                     val ctx = foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) ctx vis
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 1c76250f..d5e190fa 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -260,6 +260,21 @@
 
  end
 
+ (* Wildcards are disallowed inside signatures.
+  * We use a flag to indicate when we are in a signature,
+  * with a helper function for entering this mode and properly backing out afterward. *)
+ val inSignature = ref false
+ fun enterSignature' b f =
+     let
+         val inS = !inSignature
+     in
+         inSignature := b;
+         (f () handle ex => (inSignature := inS; raise ex))
+         before inSignature := inS
+     end
+ fun enterSignature f = enterSignature' true f
+ fun exitSignature f = enterSignature' false f
+ 
  fun elabKind env (k, loc) =
      case k of
          L.KType => (L'.KType, loc)
@@ -268,7 +283,7 @@
        | L.KRecord k => (L'.KRecord (elabKind env k), loc)
        | L.KUnit => (L'.KUnit, loc)
        | L.KTuple ks => (L'.KTuple (map (elabKind env) ks), loc)
-       | L.KWild => kunif env loc
+       | L.KWild => if !inSignature then (kindError env (KDisallowedWildcard loc); kerror) else kunif env loc
 
        | L.KVar s => (case E.lookupK env s of
                           NONE =>
@@ -531,11 +546,15 @@
          end
 
        | L.CWild k =>
-         let
-             val k' = elabKind env k
-         in
-             (cunif env (loc, k'), k', [])
-         end
+         if !inSignature then
+             (conError env (CDisallowedWildcard loc);
+              (cerror, kerror, []))
+         else
+             let
+                 val k' = elabKind env k
+             in
+                 (cunif env (loc, k'), k', [])
+             end
 
  fun kunifsRemain k =
      case k of
@@ -2560,7 +2579,10 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
          let
              val k' = case ko of
                           NONE => kunif env loc
-                        | SOME k => elabKind env k
+                        | SOME k => exitSignature (fn () => elabKind env k)
+                          (* Waive wildcard restriction within translation
+                           * of kind annotation.  The kind of [c] will allow
+                           * us to resolve it fully. *)
 
              val (c', ck, gs') = elabCon (env, denv) c
              val (env', n) = E.pushCNamed env x k' (SOME c')
@@ -2712,7 +2734,7 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
              val ct = (L'.CApp (ct, c'), loc)
              val ct = (L'.CApp (ct, (L'.CConcat (pkey, uniques), loc)), loc)
 
-             val (pe', pet, gs'') = elabExp (env', denv) pe
+             val (pe', pet, gs'') = exitSignature (fn () => elabExp (env', denv) pe)
              val gs'' = List.mapPartial (fn Disjoint x => SOME x
                                           | _ => NONE) gs''
 
@@ -2720,7 +2742,7 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
              val pst = (L'.CApp (pst, c'), loc)
              val pst = (L'.CApp (pst, pkey), loc)
 
-             val (ce', cet, gs''') = elabExp (env', denv) ce
+             val (ce', cet, gs''') = exitSignature (fn () => elabExp (env', denv) ce)
              val gs''' = List.mapPartial (fn Disjoint x => SOME x
                                            | _ => NONE) gs'''
 
@@ -4146,7 +4168,7 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
 
               | L.DSgn (x, sgn) =>
                 let
-                    val (sgn', gs') = elabSgn (env, denv) sgn
+                    val (sgn', gs') = enterSignature (fn () => elabSgn (env, denv) sgn)
                     val (env', n) = E.pushSgnNamed env x sgn'
                 in
                     ([(L'.DSgn (x, n, sgn'), loc)], (env', denv, enD gs' @ gs))
@@ -4172,7 +4194,7 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                                   else
                                       ()
 
-                         val formal = Option.map (elabSgn (env, denv)) sgno
+                         val formal = enterSignature (fn () => Option.map (elabSgn (env, denv)) sgno)
 
                          val (str', sgn', gs') =
                              case formal of
@@ -4227,7 +4249,7 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                      let
                          val () = ErrorMsg.startElabStructure x
 
-                         val (sgn', gs') = elabSgn (env, denv) sgn
+                         val (sgn', gs') = enterSignature (fn () => elabSgn (env, denv) sgn)
                                            
                          val (env', n) = E.pushStrNamed env x sgn'
 
@@ -4747,6 +4769,7 @@ fun elabFile basis basis_tm topStr topSgn top_tm env file =
         val () = mayDelay := true
         val () = delayedUnifs := []
         val () = delayedExhaustives := []
+        val () = inSignature := false
 
         val d = (L.DFfiStr ("Basis", (L.SgnConst basis, ErrorMsg.dummySpan), SOME basis_tm), ErrorMsg.dummySpan)
         val (basis_n, env', sgn) =
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index bbee8c90..7f8540f2 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -107,6 +107,8 @@ fun usage flag_info =
 
 (* Encapsulate main invocation handler in a function, possibly to be called multiple times within a daemon. *)
 
+exception DaemonExit
+
 fun oneRun args =
     let
         val timing = ref false
@@ -261,7 +263,8 @@ fun oneRun args =
         ]
 
         val () = case args of
-                     ["daemon", "stop"] => OS.Process.exit OS.Process.success
+                     ["daemon", "stop"] => (OS.FileSys.remove socket handle OS.SysErr _ => ();
+                                            raise DaemonExit)
                    | _ => ()
 
         val sources = parse_flags (flag_info ()) args
@@ -324,128 +327,138 @@ fun send (sock, s) =
             send (sock, String.extract (s, n, NONE))
     end
 
-val () = (Globals.setResetTime ();
-          case CommandLine.arguments () of
-             ["daemon", "start"] =>
-             (case Posix.Process.fork () of
-                  SOME _ => ()
-                | NONE =>
-                  let
-                      val () = Elaborate.incremental := true
-                      val listen = UnixSock.Strm.socket ()
-
-                      fun loop () =
-                          let
-                              val (sock, _) = Socket.accept listen
-
-                              fun loop' (buf, args) =
-                                  let
-                                      val s = if CharVector.exists (fn ch => ch = #"\n") buf then
-                                                  ""
-                                              else
-                                                  MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly (Socket.recvVec (sock, 1024))))
-                                      val s = buf ^ s
-                                      val (befor, after) = Substring.splitl (fn ch => ch <> #"\n") (Substring.full s)
-                                  in
-                                      if Substring.isEmpty after then
-                                          loop' (s, args)
-                                      else
-                                          let
-                                              val cmd = Substring.string befor
-                                              val rest = Substring.string (Substring.slice (after, 1, NONE))
-                                          in
-                                              case cmd of
-                                                  "" =>
-                                                  (case args of
-                                                       ["stop", "daemon"] =>
-                                                       (((Socket.close listen;
-                                                          OS.FileSys.remove socket) handle OS.SysErr _ => ());
-                                                        OS.Process.exit OS.Process.success)
-                                                     | _ =>
-                                                       let
-                                                           val success = (oneRun (rev args))
-                                                               handle ex => (print "unhandled exception:\n";
-                                                                             print (General.exnMessage ex ^ "\n");
-                                                                             OS.Process.failure)
-                                                       in
-                                                           TextIO.flushOut TextIO.stdOut;
-                                                           TextIO.flushOut TextIO.stdErr;
-                                                           send (sock, if OS.Process.isSuccess success then
-                                                                           "\001"
-                                                                       else
-                                                                           "\002")
-                                                       end)
-                                                | _ => loop' (rest, cmd :: args)
-                                          end
-                                  end handle OS.SysErr _ => ()
-
-                              fun redirect old =
-                                  Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
-                                                 new = old}
-
-                              val oldStdout = Posix.IO.dup Posix.FileSys.stdout
-                              val oldStderr = Posix.IO.dup Posix.FileSys.stderr
-                          in
-                              (* Redirect the daemon's output to the socket. *)
-                              redirect Posix.FileSys.stdout;
-                              redirect Posix.FileSys.stderr;
-
-                              loop' ("", []);
-                              Socket.close sock;
-
-                              Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
-                              Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
-                              Posix.IO.close oldStdout;
-                              Posix.IO.close oldStderr;
-
-                              Settings.reset ();
-                              MLton.GC.pack ();
-                              loop ()
-                          end
-                  in
-                      OS.Process.atExit (fn () => OS.FileSys.remove socket);
-                      Socket.bind (listen, UnixSock.toAddr socket);
-                      Socket.listen (listen, 1);
-                      loop ()
-                  end)
-           | args =>
+fun startDaemon () =
+    if OS.FileSys.access (socket, []) then
+        (print ("It looks like a daemon is already listening in this directory,\n"
+                ^ "though it's possible a daemon died without cleaning up its socket.\n");
+         OS.Process.exit OS.Process.failure)
+    else case Posix.Process.fork () of
+             SOME _ => ()
+           | NONE =>
              let
-                 val sock = UnixSock.Strm.socket ()
+                 val () = Elaborate.incremental := true
+                 val listen = UnixSock.Strm.socket ()
 
-                 fun wait () =
+                 fun loop () =
                      let
-                         val v = Socket.recvVec (sock, 1024)
-                     in
-                         if Word8Vector.length v = 0 then
-                             OS.Process.failure
-                         else
+                         val (sock, _) = Socket.accept listen
+
+                         fun loop' (buf, args) =
                              let
-                                 val s = MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly v))
-                                 val last = Word8Vector.sub (v, Word8Vector.length v - 1)
-                                 val (rc, s) = if last = Word8.fromInt 1 then
-                                                   (SOME OS.Process.success, String.substring (s, 0, size s - 1))
-                                               else if last = Word8.fromInt 2 then
-                                                   (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
-                                               else
-                                                   (NONE, s)
+                                 val s = if CharVector.exists (fn ch => ch = #"\n") buf then
+                                             ""
+                                         else
+                                             MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly (Socket.recvVec (sock, 1024))))
+                                 val s = buf ^ s
+                                 val (befor, after) = Substring.splitl (fn ch => ch <> #"\n") (Substring.full s)
                              in
-                                 print s;
-                                 case rc of
-                                     NONE => wait ()
-                                   | SOME rc => rc
-                             end
-                     end handle OS.SysErr _ => OS.Process.failure
+                                 if Substring.isEmpty after then
+                                     loop' (s, args)
+                                 else
+                                     let
+                                         val cmd = Substring.string befor
+                                         val rest = Substring.string (Substring.slice (after, 1, NONE))
+                                     in
+                                         case cmd of
+                                             "" =>
+                                             (case args of
+                                                  ["stop", "daemon"] =>
+                                                  (((Socket.close listen;
+                                                     OS.FileSys.remove socket) handle OS.SysErr _ => ());
+                                                   OS.Process.exit OS.Process.success)
+                                                | _ =>
+                                                  let
+                                                      val success = (oneRun (rev args) handle DaemonExit => OS.Process.exit OS.Process.success)
+                                                                    handle ex => (print "unhandled exception:\n";
+                                                                                  print (General.exnMessage ex ^ "\n");
+                                                                                  OS.Process.failure)
+                                                  in
+                                                      TextIO.flushOut TextIO.stdOut;
+                                                      TextIO.flushOut TextIO.stdErr;
+                                                      send (sock, if OS.Process.isSuccess success then
+                                                                      "\001"
+                                                                  else
+                                                                      "\002")
+                                                  end)
+                                           | _ => loop' (rest, cmd :: args)
+                                     end
+                             end handle OS.SysErr _ => ()
+
+                         fun redirect old =
+                             Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
+                                            new = old}
+
+                         val oldStdout = Posix.IO.dup Posix.FileSys.stdout
+                         val oldStderr = Posix.IO.dup Posix.FileSys.stderr
+                     in
+                         (* Redirect the daemon's output to the socket. *)
+                         redirect Posix.FileSys.stdout;
+                         redirect Posix.FileSys.stderr;
+
+                         loop' ("", []);
+                         Socket.close sock;
+
+                         Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
+                         Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
+                         Posix.IO.close oldStdout;
+                         Posix.IO.close oldStderr;
+
+                         Settings.reset ();
+                         MLton.GC.pack ();
+                         loop ()
+                     end
              in
-                 if Socket.connectNB (sock, UnixSock.toAddr socket)
-                    orelse not (List.null (#wrs (Socket.select {rds = [],
-                                                                wrs = [Socket.sockDesc sock],
-                                                                exs = [],
-                                                                timeout = SOME (Time.fromSeconds 1)}))) then
-                     (app (fn arg => send (sock, arg ^ "\n")) args;
-                      send (sock, "\n");
-                      OS.Process.exit (wait ()))
-                 else
-                     (OS.FileSys.remove socket;
-                      raise OS.SysErr ("", NONE))
-             end handle OS.SysErr _ =>
-                        OS.Process.exit (oneRun args))
+                 OS.Process.atExit (fn () => OS.FileSys.remove socket);
+                 Socket.bind (listen, UnixSock.toAddr socket);
+                 Socket.listen (listen, 1);
+                 loop ()
+             end
+
+fun oneCommandLine args =
+    let
+        val sock = UnixSock.Strm.socket ()
+
+        fun wait () =
+            let
+                val v = Socket.recvVec (sock, 1024)
+            in
+                if Word8Vector.length v = 0 then
+                    OS.Process.failure
+                else
+                    let
+                        val s = MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly v))
+                        val last = Word8Vector.sub (v, Word8Vector.length v - 1)
+                        val (rc, s) = if last = Word8.fromInt 1 then
+                                          (SOME OS.Process.success, String.substring (s, 0, size s - 1))
+                                      else if last = Word8.fromInt 2 then
+                                          (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
+                                      else
+                                          (NONE, s)
+                    in
+                        print s;
+                        case rc of
+                            NONE => wait ()
+                          | SOME rc => rc
+                    end
+            end handle OS.SysErr _ => OS.Process.failure
+    in
+        if Socket.connectNB (sock, UnixSock.toAddr socket)
+           orelse not (List.null (#wrs (Socket.select {rds = [],
+                                                       wrs = [Socket.sockDesc sock],
+                                                       exs = [],
+                                                       timeout = SOME (Time.fromSeconds 1)}))) then
+            (app (fn arg => send (sock, arg ^ "\n")) args;
+             send (sock, "\n");
+             wait ())
+        else
+            (OS.FileSys.remove socket;
+             raise OS.SysErr ("", NONE))
+    end handle OS.SysErr _ => oneRun args handle DaemonExit => OS.Process.success
+            
+val () = (Globals.setResetTime ();
+          case CommandLine.arguments () of
+              ["daemon", "start"] => startDaemon ()
+            | ["daemon", "restart"] =>
+              (ignore (oneCommandLine ["daemon", "stop"]);
+               startDaemon ())
+            | args => OS.Process.exit (oneCommandLine args))
diff --git a/src/mono.sml b/src/mono.sml
index cdadded5..754fe283 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -142,7 +142,7 @@ datatype decl' =
        | DTable of string * (string * typ) list * exp * exp
        | DSequence of string
        | DView of string * (string * typ) list * exp
-       | DDatabase of {name : string, expunge : int, initialize : int}
+       | DDatabase of {name : string, expunge : int, initialize : int, usesSimilar : bool}
 
        | DJavaScript of string
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a3b55ec0..1114a4f0 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -509,16 +509,17 @@ fun p_decl env (dAll as (d, _) : decl) =
                                 space,
                                 p_exp env e,
                                 string "*)"]
-      | DDatabase {name, expunge, initialize} => box [string "database",
-                                                      space,
-                                                      string name,
-                                                      space,
-                                                      string "(",
-                                                      p_enamed env expunge,
-                                                      string ",",
-                                                      space,
-                                                      p_enamed env initialize,
-                                                      string ")"]
+      | DDatabase {name, expunge, initialize, ...} =>
+        box [string "database",
+             space,
+             string name,
+             space,
+             string "(",
+             p_enamed env expunge,
+             string ",",
+             space,
+             p_enamed env initialize,
+             string ")"]
       | DJavaScript s => box [string "JavaScript(",
                               string s,
                               string ")"]
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 5bcb6f57..c3c9da98 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -597,8 +597,7 @@ fun reduce' (file : file) =
                             ((*Print.prefaces "trySub"
                                             [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*)
                              case t of
-                                 (TFfi ("Basis", "string"), _) => doSub ()
-                               | (TSignal _, _) => e
+                                 (TSignal _, _) => e
                                | _ =>
                                  case e' of
                                      (ECase _, _) => e
diff --git a/src/monoize.sml b/src/monoize.sml
index 4aeddcae..22b4e0e7 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -50,11 +50,13 @@ structure RM = BinaryMapFn(struct
                                                                         (L'.TRecord r2, E.dummySpan))
                            end)
 
+val uses_similar = ref false
+
 local
     val url_prefixes = ref []
 in
 
-fun reset () = url_prefixes := []
+fun reset () = (url_prefixes := []; uses_similar := false)
 
 fun addPrefix prefix =
     let
@@ -355,6 +357,8 @@ fun monoType env =
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_ufunc"), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_bfunc"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_partition"), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window"), _), _), _), _), _), _), _), _) =>
@@ -2693,6 +2697,40 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) =>
             ((L'.EFfi ("Basis", "sql_known"), loc), fm)
 
+          | L.ECApp (
+                (L.ECApp (
+                      (L.ECApp (
+                            (L.ECApp (
+                                  (L.ECApp (
+                                        (L.ECApp (
+                                              (L.EFfi ("Basis", "sql_bfunc"), _),
+                                              _), _),
+                                        _), _),
+                                  _), _),
+                            _), _),
+                      _), _),
+                _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("x1", s, s,
+                                     (L'.EAbs ("x2", s, s,
+                                               strcat [(L'.ERel 2, loc),
+                                                       str "(",
+                                                       (L'.ERel 1, loc),
+                                                       str ",",
+                                                       (L'.ERel 0, loc),
+                                                       str ")"]), loc)), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_similarity") =>
+            ((case #supportsSimilar (Settings.currentDbms ()) of
+                  NONE => ErrorMsg.errorAt loc "The DBMS you've selected doesn't support SIMILAR."
+                | _ => ());
+             uses_similar := true;
+             (str "similarity", fm))
+
           | (L.ECApp (
              (L.ECApp (
               (L.ECApp (
@@ -4593,7 +4631,8 @@ fun monoize env file =
                                             in
                                                 (env, Fm.enter fm, (L'.DDatabase {name = s,
                                                                                   expunge = nExp,
-                                                                                  initialize = nIni}, loc)
+                                                                                  initialize = nIni,
+                                                                                  usesSimilar = false}, loc)
                                                                    :: (dExp, loc)
                                                                    :: (dIni, loc)
                                                                    :: ds)
@@ -4617,6 +4656,12 @@ fun monoize env file =
                                                     | _ =>
                                                       ds' @ Fm.decls fm @ (L'.DDatatype (!pvarDefs), loc) :: ds)))
                                      (env, Fm.empty mname, []) file
+        val ds = map (fn (L'.DDatabase r, loc) =>
+                         (L'.DDatabase {name = #name r,
+                                        expunge = #expunge r,
+                                        initialize = #initialize r,
+                                        usesSimilar = !uses_similar}, loc)
+                     | x => x) ds
         val monoFile = (rev ds, [])
     in
         pvars := RM.empty;
diff --git a/src/mysql.sml b/src/mysql.sml
index ff1c379d..74954c0f 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1612,6 +1612,7 @@ val () = addDbms {name = "mysql",
                   requiresTimestampDefaults = true,
                   supportsIsDistinctFrom = true,
                   supportsSHA512 = SOME {InitializeDb = "",
-                                         GenerateHash = fn name => "SHA2(" ^ name ^ ", 512)"}}
+                                         GenerateHash = fn name => "SHA2(" ^ name ^ ", 512)"},
+                  supportsSimilar = NONE}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index 94f0e42e..3e53ed77 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -1155,8 +1155,9 @@ val () = addDbms {name = "postgres",
                   windowFunctions = true,
                   requiresTimestampDefaults = false,
                   supportsIsDistinctFrom = true,
-                  supportsSHA512 = SOME {InitializeDb = "CREATE EXTENSION pgcrypto;",
-                                         GenerateHash = fn name => "DIGEST(" ^ name ^ ", 'sha512')"}}
+                  supportsSHA512 = SOME {InitializeDb = "CREATE EXTENSION IF NOT EXISTS pgcrypto;",
+                                         GenerateHash = fn name => "DIGEST(" ^ name ^ ", 'sha512')"},
+                  supportsSimilar = SOME {InitializeDb = "CREATE EXTENSION IF NOT EXISTS pg_trgm;"}}
 
 val () = setDbms "postgres"
 
diff --git a/src/reduce_local.sml b/src/reduce_local.sml
index 06f49fef..aee8e7a9 100644
--- a/src/reduce_local.sml
+++ b/src/reduce_local.sml
@@ -54,6 +54,14 @@ val deKnown = List.filter (fn Known _ => false
                             | KnownC _ => false
                             | _ => true)
 
+fun p_env_item ei =
+    Print.PD.string (case ei of
+                         Unknown => "?"
+                       | Known _ => "K"
+                       | UnknownC => "C?"
+                       | KnownC _ => "CK"
+                       | Lift _ => "^")
+                          
 datatype result = Yes of env | No | Maybe
 
 fun match (env, p : pat, e : exp) =
@@ -124,7 +132,8 @@ fun match (env, p : pat, e : exp) =
     end
 
 fun con env (all as (c, loc)) =
-    ((*Print.prefaces "con" [("c", CorePrint.p_con CoreEnv.empty all)];*)
+    ((*Print.prefaces "con" [("c", CorePrint.p_con CoreEnv.empty all),
+                           ("env", Print.p_list p_env_item env)];*)
      case c of
          TFun (c1, c2) => (TFun (con env c1, con env c2), loc)
        | TCFun (x, k, c2) => (TCFun (x, k, con (UnknownC :: env) c2), loc)
@@ -139,7 +148,7 @@ fun con env (all as (c, loc)) =
                    | Unknown :: rest => find (n', rest, nudge, liftC)
                    | Known _ :: rest => find (n', rest, nudge, liftC)
                    | Lift (liftC', _) :: rest => find (n', rest, nudge + liftC',
-                                                               liftC + liftC')
+                                                       liftC + liftC')
                    | UnknownC :: rest =>
                      if n' = 0 then
                          (CRel (n + nudge), loc)
@@ -228,154 +237,156 @@ fun patCon pc =
                  kind = kind}
 
 fun exp env (all as (e, loc)) =
-    case e of
-        EPrim _ => all
-      | ERel n =>
-        let
-            fun find (n', env, nudge, liftC, liftE) =
-                case env of
-                    [] => (ERel (n + nudge), loc)
-                  | Lift (liftC', liftE') :: rest => find (n', rest, nudge + liftE', liftC + liftC', liftE + liftE')
-                  | UnknownC :: rest => find (n', rest, nudge, liftC + 1, liftE)
-                  | KnownC _ :: rest => find (n', rest, nudge, liftC, liftE)
-                  | Unknown :: rest =>
-                    if n' = 0 then
-                        (ERel (n + nudge), loc)
-                    else
-                        find (n' - 1, rest, nudge, liftC, liftE + 1)
-                  | Known e :: rest =>
-                    if n' = 0 then
-                        ((*print "SUBSTITUTING\n";*)
-                         exp (Lift (liftC, liftE) :: rest) e)
-                    else
-                        find (n' - 1, rest, nudge - 1, liftC, liftE)
-        in
-            find (n, env, 0, 0, 0)
-        end
-      | ENamed _ => all
-      | ECon (dk, pc, cs, eo) => (ECon (dk, patCon pc, map (con env) cs, Option.map (exp env) eo), loc)
-      | EFfi _ => all
-      | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc)
-
-      | EApp (e1, e2) =>
-        let
-            val e1 = exp env e1
-            val e2 = exp env e2
-        in
-            case #1 e1 of
-                EAbs (_, _, _, b) => exp (Known e2 :: deKnown env) b
-              | _ => (EApp (e1, e2), loc)
-        end
-
-      | EAbs (x, dom, ran, e) => (EAbs (x, con env dom, con env ran, exp (Unknown :: env) e), loc)
-
-      | ECApp (e, c) =>
-        let
-            val e = exp env e
-            val c = con env c
-        in
-            case #1 e of
-                ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b
-              | _ => (ECApp (e, c), loc)
-        end
-
-      | ECAbs (x, k, e) => (ECAbs (x, k, exp (UnknownC :: env) e), loc)
-
-      | EKApp (e, k) => (EKApp (exp env e, k), loc)
-      | EKAbs (x, e) => (EKAbs (x, exp env e), loc)
-
-      | ERecord xcs => (ERecord (map (fn (x, e, t) => (con env x, exp env e, con env t)) xcs), loc)
-      | EField (e, c, {field = f, rest = r}) =>
-        let
-            val e = exp env e
-            val c = con env c
-
-            fun default () = (EField (e, c, {field = con env f, rest = con env r}), loc)
-        in
-            case (#1 e, #1 c) of
-                (ERecord xcs, CName x) =>
-                (case List.find (fn ((CName x', _), _, _) => x' = x | _ => false) xcs of
-                     NONE => default ()
-                   | SOME (_, e, _) => e)
-              | _ => default ()
-        end
-
-      | EConcat (e1, c1, e2, c2) => (EConcat (exp env e1, con env c1, exp env e2, con env c2), loc)
-      | ECut (e, c, {field = f, rest = r}) => (ECut (exp env e,
-                                                     con env c,
-                                                     {field = con env f, rest = con env r}), loc)
-      | ECutMulti (e, c, {rest = r}) => (ECutMulti (exp env e, con env c, {rest = con env r}), loc)
-
-      | ECase (e, pes, {disc = d, result = r}) =>
-        let
-            val others = {disc = con env d, result = con env r}
-
-            fun patBinds (p, _) =
-                case p of
-                    PVar _ => 1
-                  | PPrim _ => 0
-                  | PCon (_, _, _, NONE) => 0
-                  | PCon (_, _, _, SOME p) => patBinds p
-                  | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
-
-            fun pat (all as (p, loc)) =
-                case p of
-                    PVar (x, t) => (PVar (x, con env t), loc)
-                  | PPrim _ => all
-                  | PCon (dk, pc, cs, po) =>
-                    (PCon (dk, patCon pc, map (con env) cs, Option.map pat po), loc)
-                  | PRecord xpts => (PRecord (map (fn (x, p, t) => (x, pat p, con env t)) xpts), loc)
-
-            fun push () =
-                (ECase (exp env e,
-                        map (fn (p, e) => (pat p,
-                                           exp (List.tabulate (patBinds p,
-                                                            fn _ => Unknown) @ env) e))
-                            pes, others), loc)
-
-            fun search pes =
-                case pes of
-                    [] => push ()
-                  | (p, body) :: pes =>
-                    case match (env, p, e) of
-                        No => search pes
-                      | Maybe => push ()
-                      | Yes env' => exp env' body
-        in
-            search pes
-        end
-
-      | EWrite e => (EWrite (exp env e), loc)
-      | EClosure (n, es) => (EClosure (n, map (exp env) es), loc)
-
-      | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (Unknown :: env) e2), loc)
-
-      | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc)
+    ((*Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all)];*)
+     case e of
+         EPrim _ => all
+       | ERel n =>
+         let
+             fun find (n', env, nudge, liftC, liftE) =
+                 case env of
+                     [] => (ERel (n + nudge), loc)
+                   | Lift (liftC', liftE') :: rest => find (n', rest, nudge + liftE', liftC + liftC', liftE + liftE')
+                   | UnknownC :: rest => find (n', rest, nudge, liftC + 1, liftE)
+                   | KnownC _ :: rest => find (n', rest, nudge, liftC, liftE)
+                   | Unknown :: rest =>
+                     if n' = 0 then
+                         (ERel (n + nudge), loc)
+                     else
+                         find (n' - 1, rest, nudge, liftC, liftE + 1)
+                   | Known e :: rest =>
+                     if n' = 0 then
+                         ((*print "SUBSTITUTING\n";*)
+                           exp (Lift (liftC, liftE) :: rest) e)
+                     else
+                         find (n' - 1, rest, nudge - 1, liftC, liftE)
+         in
+             find (n, env, 0, 0, 0)
+         end
+       | ENamed _ => all
+       | ECon (dk, pc, cs, eo) => (ECon (dk, patCon pc, map (con env) cs, Option.map (exp env) eo), loc)
+       | EFfi _ => all
+       | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc)
+
+       | EApp (e1, e2) =>
+         let
+             val e1 = exp env e1
+             val e2 = exp env e2
+         in
+             case #1 e1 of
+                 EAbs (_, _, _, b) => exp (Known e2 :: deKnown env) b
+               | _ => (EApp (e1, e2), loc)
+         end
+
+       | EAbs (x, dom, ran, e) => (EAbs (x, con env dom, con env ran, exp (Unknown :: env) e), loc)
+
+       | ECApp (e, c) =>
+         let
+             val e = exp env e
+             val c = con env c
+         in
+             case #1 e of
+                 ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b
+               | _ => (ECApp (e, c), loc)
+         end
+
+       | ECAbs (x, k, e) => (ECAbs (x, k, exp (UnknownC :: env) e), loc)
+
+       | EKApp (e, k) => (EKApp (exp env e, k), loc)
+       | EKAbs (x, e) => (EKAbs (x, exp env e), loc)
+
+       | ERecord xcs => (ERecord (map (fn (x, e, t) => (con env x, exp env e, con env t)) xcs), loc)
+       | EField (e, c, {field = f, rest = r}) =>
+         let
+             val e = exp env e
+             val c = con env c
+
+             fun default () = (EField (e, c, {field = con env f, rest = con env r}), loc)
+         in
+             case (#1 e, #1 c) of
+                 (ERecord xcs, CName x) =>
+                 (case List.find (fn ((CName x', _), _, _) => x' = x | _ => false) xcs of
+                      NONE => default ()
+                    | SOME (_, e, _) => e)
+               | _ => default ()
+         end
+
+       | EConcat (e1, c1, e2, c2) => (EConcat (exp env e1, con env c1, exp env e2, con env c2), loc)
+       | ECut (e, c, {field = f, rest = r}) => (ECut (exp env e,
+                                                      con env c,
+                                                      {field = con env f, rest = con env r}), loc)
+       | ECutMulti (e, c, {rest = r}) => (ECutMulti (exp env e, con env c, {rest = con env r}), loc)
+
+       | ECase (e, pes, {disc = d, result = r}) =>
+         let
+             val others = {disc = con env d, result = con env r}
+
+             fun patBinds (p, _) =
+                 case p of
+                     PVar _ => 1
+                   | PPrim _ => 0
+                   | PCon (_, _, _, NONE) => 0
+                   | PCon (_, _, _, SOME p) => patBinds p
+                   | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
+
+             fun pat (all as (p, loc)) =
+                 case p of
+                     PVar (x, t) => (PVar (x, con env t), loc)
+                   | PPrim _ => all
+                   | PCon (dk, pc, cs, po) =>
+                     (PCon (dk, patCon pc, map (con env) cs, Option.map pat po), loc)
+                   | PRecord xpts => (PRecord (map (fn (x, p, t) => (x, pat p, con env t)) xpts), loc)
+
+             fun push () =
+                 (ECase (exp env e,
+                         map (fn (p, e) => (pat p,
+                                            exp (List.tabulate (patBinds p,
+                                                                fn _ => Unknown) @ env) e))
+                             pes, others), loc)
+
+             fun search pes =
+                 case pes of
+                     [] => push ()
+                   | (p, body) :: pes =>
+                     case match (env, p, e) of
+                         No => search pes
+                       | Maybe => push ()
+                       | Yes env' => exp env' body
+         in
+             search pes
+         end
+
+       | EWrite e => (EWrite (exp env e), loc)
+       | EClosure (n, es) => (EClosure (n, map (exp env) es), loc)
+
+       | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (Unknown :: env) e2), loc)
+
+       | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc))
 
 fun reduce file =
     let
         fun doDecl (d as (_, loc)) =
-            case #1 d of
-                DCon _ => d
-              | DDatatype _ => d
-              | DVal (x, n, t, e, s) =>
-                let
-                    val e = exp [] e
-                in
-                    (DVal (x, n, t, e, s), loc)
-                end
-              | DValRec vis =>
-                (DValRec (map (fn (x, n, t, e, s) => (x, n, t, exp [] e, s)) vis), loc)
-              | DExport _ => d
-              | DTable _ => d
-              | DSequence _ => d
-              | DView _ => d
-              | DDatabase _ => d
-              | DCookie _ => d
-              | DStyle _ => d
-              | DTask (e1, e2) => (DTask (exp [] e1, exp [] e2), loc)
-              | DPolicy e1 => (DPolicy (exp [] e1), loc)
-              | DOnError _ => d
+            ((*Print.prefaces "decl" [("d", CorePrint.p_decl CoreEnv.empty d)];*)
+             case #1 d of
+                 DCon _ => d
+               | DDatatype _ => d
+               | DVal (x, n, t, e, s) =>
+                 let
+                     val e = exp [] e
+                 in
+                     (DVal (x, n, t, e, s), loc)
+                 end
+               | DValRec vis =>
+                 (DValRec (map (fn (x, n, t, e, s) => (x, n, t, exp [] e, s)) vis), loc)
+               | DExport _ => d
+               | DTable _ => d
+               | DSequence _ => d
+               | DView _ => d
+               | DDatabase _ => d
+               | DCookie _ => d
+               | DStyle _ => d
+               | DTask (e1, e2) => (DTask (exp [] e1, exp [] e2), loc)
+               | DPolicy e1 => (DPolicy (exp [] e1), loc)
+               | DOnError _ => d)
     in
         map doDecl file
     end
diff --git a/src/settings.sig b/src/settings.sig
index a2a56407..6a409cdd 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -224,10 +224,11 @@ signature SETTINGS = sig
          requiresTimestampDefaults : bool,
          supportsIsDistinctFrom : bool,
          supportsSHA512 : {InitializeDb : string,
-                           GenerateHash : string -> string} option
+                           GenerateHash : string -> string} option,
          (* If supported, give the SQL code to
           * enable the feature in a particular
           * database and to compute a hash of a value. *)
+         supportsSimilar : {InitializeDb : string} option
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index a85e8053..c8cb049c 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -653,7 +653,8 @@ type dbms = {
      windowFunctions: bool,
      requiresTimestampDefaults : bool,
      supportsIsDistinctFrom : bool,
-     supportsSHA512 : {InitializeDb : string, GenerateHash : string -> string} option
+     supportsSHA512 : {InitializeDb : string, GenerateHash : string -> string} option,
+     supportsSimilar : {InitializeDb : string} option
 }
 
 val dbmses = ref ([] : dbms list)
@@ -688,7 +689,8 @@ val curDb = ref ({name = "",
                   windowFunctions = false,
                   requiresTimestampDefaults = false,
                   supportsIsDistinctFrom = false,
-                  supportsSHA512 = NONE} : dbms)
+                  supportsSHA512 = NONE,
+                  supportsSimilar = NONE} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff --git a/src/sqlite.sml b/src/sqlite.sml
index 9bb86ecf..0e97bf69 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -857,6 +857,7 @@ val () = addDbms {name = "sqlite",
                   windowFunctions = false,
                   requiresTimestampDefaults = false,
                   supportsIsDistinctFrom = false,
-                  supportsSHA512 = NONE}
+                  supportsSHA512 = NONE,
+                  supportsSimilar = NONE}
 
 end
diff --git a/src/urweb.grm b/src/urweb.grm
index afebff0a..dea7bdf5 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -2276,6 +2276,15 @@ sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True", In
                                              val e = (EApp (e, fname), loc)
                                          in
                                              (EApp (e, sqlexp), loc)
+                                        end)
+       | fname LPAREN sqlexp COMMA sqlexp RPAREN (let
+                                             val loc = s (fnameleft, RPARENright)
+
+                                             val e = (EVar (["Basis"], "sql_bfunc", Infer), loc)
+                                             val e = (EApp (e, fname), loc)
+                                             val e = (EApp (e, sqlexp1), loc)
+                                         in
+                                             (EApp (e, sqlexp2), loc)
                                          end)
        | LPAREN query RPAREN            (let
                                              val loc = s (LPARENleft, RPARENright)