From e16efaf6603c4da33b74b499e0e1214c46ddf72d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 17 Jul 2019 14:28:46 -0400
Subject: New JavaScript FFI function 'listen'

---
 doc/manual.tex  |  1 +
 lib/js/urweb.js | 10 ++++++++++
 2 files changed, 11 insertions(+)

diff --git a/doc/manual.tex b/doc/manual.tex
index ba53f5d8..62b322ae 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2573,6 +2573,7 @@ It is possible to write JavaScript FFI code that interacts with the functional-r
   \item \cd{sr(v)} and \cd{sb(s, f)}, the ``return'' and ``bind'' monad operators, respectively
   \item \cd{ss(s)}, to produce the signal corresponding to source \cd{s}
   \item \cd{scur(s)}, to get the current value of signal \cd{s}
+  \item \cd{listen(s, f)}, to ask that function \cd{f} be called with the current value of \cd{s}, every time it changes, including immediately upon establishing this listener
   \end{itemize}
 
 \item The behavior of the \cd{<dyn>} pseudo-tag may be mimicked by following the right convention in a piece of HTML source code with a type like $\mt{xbody}$.  Such a piece of source code may be encoded with a JavaScript string.  To insert a dynamic section, include a \cd{<script>} tag whose content is just a call \cd{dyn(pnode, s)}.  The argument \cd{pnode} specifies what the relevant enclosing parent tag is.  Use value \cd{"tr"} when the immediate parent is \cd{<tr>}, use \cd{"table"} when the immediate parent is \cd{<table>}, and use \cd{"span"} otherwise.  The argument \cd{s} is a string-valued signal giving the HTML code to be inserted at this point.  As with the usual \cd{<dyn>} tag, that HTML subtree is automatically updated as the value of \cd{s} changes.
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 66d427c8..332de6dc 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -2135,6 +2135,16 @@ function active(s) {
     }
 }
 
+function listen(s, onchange) {
+    var x = document.createElement("script");
+    x.dead = false;
+    x.signal = s;
+    x.sources = null;
+    x.closures = null;
+    x.recreate = onchange;
+    populate(x);
+}
+
 function input(x, s, recreate, type, name) {
     if (name) x.name = name;
     if (type) x.type = type;
-- 
cgit v1.2.3


From 89526be4ed3328fef9ac9c8668c3611094e45d18 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Fri, 26 Jul 2019 10:09:07 -0400
Subject: Remove a misleading comment (#175)

---
 lib/ur/basis.urs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index be13c684..2a98bf6f 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -571,9 +571,6 @@ val sql_div : t ::: Type -> sql_arith t -> sql_binary t t t
 val sql_mod : sql_binary int int int
 
 val sql_eq : t ::: Type -> sql_binary t t bool
-(* Note that the semantics of this operator on nullable types are different than for standard SQL!
- * Instead, we do it the sane way, where [NULL = NULL]. *)
-
 val sql_ne : t ::: Type -> sql_binary t t bool
 val sql_lt : t ::: Type -> sql_binary t t bool
 val sql_le : t ::: Type -> sql_binary t t bool
-- 
cgit v1.2.3


From 6273c4602a8103f23856616966c34721ad726d3e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 4 Aug 2019 11:13:03 -0400
Subject: Flush output on logging

---
 src/c/http.c | 2 ++
 1 file changed, 2 insertions(+)

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);
   }
 }
 
-- 
cgit v1.2.3


From 52eb84c63a458e2a042c8fe451e96a11fdaeb4ed Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 10 Aug 2019 13:02:21 -0400
Subject: Datetime.ord_month

---
 lib/ur/datetime.ur  | 3 ++-
 lib/ur/datetime.urs | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/lib/ur/datetime.ur b/lib/ur/datetime.ur
index 9aeab291..99fd5a7d 100644
--- a/lib/ur/datetime.ur
+++ b/lib/ur/datetime.ur
@@ -88,7 +88,8 @@ fun intToMonth i = case i of
                      | n => error <xml>Invalid month number {[n]}</xml>
 
 val eq_month = mkEq (fn a b => monthToInt a = monthToInt b)
-
+val ord_month = mkOrd {Lt = fn a b => monthToInt a < monthToInt b,
+                       Le = fn a b => monthToInt a <= monthToInt b}
 
 fun toTime dt : time = fromDatetime dt.Year (monthToInt dt.Month) dt.Day
                                     dt.Hour dt.Minute dt.Second
diff --git a/lib/ur/datetime.urs b/lib/ur/datetime.urs
index 972f86bf..f8460443 100644
--- a/lib/ur/datetime.urs
+++ b/lib/ur/datetime.urs
@@ -20,6 +20,7 @@ val show_day_of_week : show day_of_week
 val show_month : show month
 val eq_day_of_week : eq day_of_week
 val eq_month : eq month
+val ord_month : ord month
 val dayOfWeekToInt : day_of_week -> int
 val intToDayOfWeek : int -> day_of_week
 val monthToInt : month -> int
-- 
cgit v1.2.3


From d7e10798f1905161e5790444e604f439281d4220 Mon Sep 17 00:00:00 2001
From: Oisín Mac Fhearaí <denpashogai@gmail.com>
Date: Sun, 11 Aug 2019 05:04:43 +0100
Subject: * When htmlifying characters, don't use numeric escapes if they're  
 printable -- instead, try to convert them to UTF-8. * Add libicuio to linked
 C libraries

---
 src/c/Makefile.am |  2 +-
 src/c/urweb.c     | 19 ++++++++++++++++---
 src/compiler.sml  |  8 ++++++--
 3 files changed, 23 insertions(+), 6 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/urweb.c b/src/c/urweb.c
index b820354f..dad15568 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -20,7 +20,6 @@
 
 #include <pthread.h>
 
-#include <unicode/utf8.h>
 #include <unicode/uchar.h>
 
 #include "types.h"
@@ -2347,7 +2346,21 @@ uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, uw_Basis_char ch) {
   int len;
 
   uw_check(ctx, INTS_MAX+3);
-  len = sprintf(ctx->page.front, "&#%u;", n);
+
+  if(uw_Basis_isprint(ctx, ch)) {
+
+    UChar32 ins[1] = { ch };
+    char buf[5];
+    int32_t len_written = 0;
+    UErrorCode err = U_ZERO_ERROR;
+
+    u_strToUTF8(buf, 5, &len_written, ins, 1, &err);
+    sprintf(ctx->page.front, "%s", buf);
+    // printf("buf: %s, hex: %x, len_written: %d, err: %s\n", buf, ch, len_written, u_errorName(err));
+    len = len_written;
+  } else {
+    len = sprintf(ctx->page.front, "&#%u;", n);
+  }
   ctx->page.front += len;
 
   return uw_unit_v;
@@ -2459,7 +2472,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;
 }
diff --git a/src/compiler.sml b/src/compiler.sml
index 0aba3a40..c00fe807 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -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"
 
-- 
cgit v1.2.3


From 71e1eb7be7ebd566a19be3cab381f813d9c2e4fc Mon Sep 17 00:00:00 2001
From: Oisín Mac Fhearaí <denpashogai@gmail.com>
Date: Sun, 11 Aug 2019 06:04:35 +0100
Subject: Add missing include

---
 src/c/urweb.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index dad15568..509ba10d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -21,6 +21,7 @@
 #include <pthread.h>
 
 #include <unicode/uchar.h>
+#include <unicode/ustring.h>
 
 #include "types.h"
 
-- 
cgit v1.2.3


From 35eaf23643fcd2eb4376f07a490c959737179eef Mon Sep 17 00:00:00 2001
From: Oisín Mac Fhearaí <denpashogai@gmail.com>
Date: Sun, 11 Aug 2019 06:14:10 +0100
Subject: Try to avoid a pointer conversion error

---
 src/c/urweb.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 509ba10d..a76f0004 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -20,8 +20,8 @@
 
 #include <pthread.h>
 
-#include <unicode/uchar.h>
 #include <unicode/ustring.h>
+#include <unicode/uchar.h>
 
 #include "types.h"
 
@@ -2350,7 +2350,7 @@ uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, uw_Basis_char ch) {
 
   if(uw_Basis_isprint(ctx, ch)) {
 
-    UChar32 ins[1] = { ch };
+    const UChar ins[1] = { ch };
     char buf[5];
     int32_t len_written = 0;
     UErrorCode err = U_ZERO_ERROR;
-- 
cgit v1.2.3


From 2bd1fc392c0b22f5eaa37919c6a26330dd72c7d4 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 17 Aug 2019 10:21:42 -0400
Subject: Generic traversal for Elab should visit let-bound patterns

---
 src/elab_util.sml    |  12 +-
 src/reduce_local.sml | 303 ++++++++++++++++++++++++++-------------------------
 2 files changed, 164 insertions(+), 151 deletions(-)

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/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
-- 
cgit v1.2.3


From 5e2ebc973f19fe8e5fdbe20e102e445329b528b0 Mon Sep 17 00:00:00 2001
From: Oisín Mac Fhearaí <denpashogai@gmail.com>
Date: Wed, 28 Aug 2019 01:56:53 +0100
Subject: Minor cleanup -- handle the case where we couldn't successfully
 generate a UTF8 codepoint by outputting a HTML escape (the default behaviour
 before for all multi-byte characters).

---
 src/c/urweb.c | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index a76f0004..62561828 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -20,6 +20,7 @@
 
 #include <pthread.h>
 
+#include <unicode/utf8.h>
 #include <unicode/ustring.h>
 #include <unicode/uchar.h>
 
@@ -2344,7 +2345,7 @@ 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);
 
@@ -2359,7 +2360,10 @@ uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, uw_Basis_char ch) {
     sprintf(ctx->page.front, "%s", buf);
     // printf("buf: %s, hex: %x, len_written: %d, err: %s\n", buf, ch, len_written, u_errorName(err));
     len = len_written;
-  } else {
+  }
+
+  // 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;
-- 
cgit v1.2.3


From 0490176b675eb3ea36cd51fa5d1fd41a3126c10c Mon Sep 17 00:00:00 2001
From: Oisín Mac Fhearaí <denpashogai@gmail.com>
Date: Thu, 29 Aug 2019 21:39:53 +0100
Subject: PR suggestions (with thanks to @fabriceleal).

---
 src/c/urweb.c | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 62561828..af929269 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -2351,14 +2351,10 @@ uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, uw_Basis_char ch) {
 
   if(uw_Basis_isprint(ctx, ch)) {
 
-    const UChar ins[1] = { ch };
-    char buf[5];
     int32_t len_written = 0;
     UErrorCode err = U_ZERO_ERROR;
 
-    u_strToUTF8(buf, 5, &len_written, ins, 1, &err);
-    sprintf(ctx->page.front, "%s", buf);
-    // printf("buf: %s, hex: %x, len_written: %d, err: %s\n", buf, ch, len_written, u_errorName(err));
+    u_strToUTF8(ctx->page.front, 5, &len_written, (const UChar*)&ch, 1, &err);
     len = len_written;
   }
 
-- 
cgit v1.2.3


From 0d644b4350f3e6cbb676360b0fc6a9e448137092 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 30 Aug 2019 16:32:14 -0400
Subject: Smooth rough edges of daemon command-line behavior

---
 src/main.mlton.sml | 247 +++++++++++++++++++++++++++--------------------------
 1 file changed, 128 insertions(+), 119 deletions(-)

diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index bfa40265..e9317d46 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -255,7 +255,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 _ => ();
+                                            OS.Process.exit OS.Process.success)
                    | _ => ()
 
         val sources = parse_flags (flag_info ()) args
@@ -318,127 +319,135 @@ 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 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
+            
+val () = (Globals.setResetTime ();
+          case CommandLine.arguments () of
+             ["daemon", "start"] => startDaemon ()
+           | args => OS.Process.exit (oneCommandLine args))
-- 
cgit v1.2.3


From f54687e989372470c2848890e9499feb9fd70352 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 30 Aug 2019 17:15:48 -0400
Subject: urweb daemon restart

---
 doc/manual.tex     |  4 ++++
 src/main.mlton.sml | 15 ++++++++++-----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/doc/manual.tex b/doc/manual.tex
index 62b322ae..64fe0f24 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -238,6 +238,10 @@ Further \cd{urweb} invocations in the same working directory will send requests
 \begin{verbatim}
 urweb daemon stop
 \end{verbatim}
+To restart a running (or crashed) daemon, run
+\begin{verbatim}
+urweb daemon restart
+\end{verbatim}
 Communication happens via a UNIX domain socket in file \cd{.urweb\_daemon} in the working directory.
 
 \medskip
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index e9317d46..a6eaa7ea 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
@@ -256,7 +258,7 @@ fun oneRun args =
 
         val () = case args of
                      ["daemon", "stop"] => (OS.FileSys.remove socket handle OS.SysErr _ => ();
-                                            OS.Process.exit OS.Process.success)
+                                            raise DaemonExit)
                    | _ => ()
 
         val sources = parse_flags (flag_info ()) args
@@ -360,7 +362,7 @@ fun startDaemon () =
                                                    OS.Process.exit OS.Process.success)
                                                 | _ =>
                                                   let
-                                                      val success = (oneRun (rev args))
+                                                      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)
@@ -445,9 +447,12 @@ fun oneCommandLine args =
         else
             (OS.FileSys.remove socket;
              raise OS.SysErr ("", NONE))
-    end handle OS.SysErr _ => oneRun args
+    end handle OS.SysErr _ => oneRun args handle DaemonExit => OS.Process.success
             
 val () = (Globals.setResetTime ();
           case CommandLine.arguments () of
-             ["daemon", "start"] => startDaemon ()
-           | args => OS.Process.exit (oneCommandLine args))
+              ["daemon", "start"] => startDaemon ()
+            | ["daemon", "restart"] =>
+              (ignore (oneCommandLine ["daemon", "stop"]);
+               startDaemon ())
+            | args => OS.Process.exit (oneCommandLine args))
-- 
cgit v1.2.3


From 39cf1b0633fd95ff82815741c9c3d35a0f762cf2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 14 Sep 2019 13:14:55 -0400
Subject: More detailed error message for bad path kind spec (closes #178)

---
 src/compiler.sml  | 2 +-
 tests/badkind.ur  | 1 +
 tests/badkind.urp | 3 +++
 3 files changed, 5 insertions(+), 1 deletion(-)
 create mode 100644 tests/badkind.ur
 create mode 100644 tests/badkind.urp

diff --git a/src/compiler.sml b/src/compiler.sml
index c00fe807..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 =
diff --git a/tests/badkind.ur b/tests/badkind.ur
new file mode 100644
index 00000000..600f7a35
--- /dev/null
+++ b/tests/badkind.ur
@@ -0,0 +1 @@
+fun main () : transaction page = <xml>ahoy!</xml>
diff --git a/tests/badkind.urp b/tests/badkind.urp
new file mode 100644
index 00000000..934e4928
--- /dev/null
+++ b/tests/badkind.urp
@@ -0,0 +1,3 @@
+rewrite Badkind/main /
+
+badkind
-- 
cgit v1.2.3


From 2a7c54badfcd4e30105a0127b25975000ff09bbb Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 18 Sep 2019 13:51:13 -0400
Subject: Disallow wildcards in signatures (should help with #174)

---
 src/elab_err.sig  |  2 ++
 src/elab_err.sml  |  6 ++++++
 src/elaborate.sml | 35 ++++++++++++++++++++++++++---------
 tests/wildsig.ur  |  7 +++++++
 4 files changed, 41 insertions(+), 9 deletions(-)
 create mode 100644 tests/wildsig.ur

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/elaborate.sml b/src/elaborate.sml
index 97b36a0b..6ffb7716 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -260,6 +260,19 @@
 
  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 f =
+     let
+         val inS = !inSignature
+     in
+         inSignature := true;
+         (f () handle ex => (inSignature := inS; raise ex))
+         before inSignature := inS
+     end
+ 
  fun elabKind env (k, loc) =
      case k of
          L.KType => (L'.KType, loc)
@@ -268,7 +281,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 +544,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
@@ -4146,7 +4163,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))
@@ -4171,7 +4188,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
@@ -4221,7 +4238,7 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                      end
                    | NONE =>
                      let
-                         val (sgn', gs') = elabSgn (env, denv) sgn
+                         val (sgn', gs') = enterSignature (fn () => elabSgn (env, denv) sgn)
                                            
                          val (env', n) = E.pushStrNamed env x sgn'
 
diff --git a/tests/wildsig.ur b/tests/wildsig.ur
new file mode 100644
index 00000000..336772a7
--- /dev/null
+++ b/tests/wildsig.ur
@@ -0,0 +1,7 @@
+signature S = sig
+    val x : _
+end
+
+structure M : S = struct
+    val x = 7
+end
-- 
cgit v1.2.3


From 3f8929c83b451837fcd9dc9475534c0e78967ab2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 18 Sep 2019 15:33:35 -0400
Subject: Signatures should be allowed to use wildcards for kinds associated
 with concrete constructors

---
 src/elaborate.sml | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/elaborate.sml b/src/elaborate.sml
index 6ffb7716..c6825150 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2577,7 +2577,14 @@ 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 =>
+                          case #1 k of
+                              L.KWild => kunif env loc
+                            (* Why duplicate this case of elabKind here?
+                             * To avoid flagging a disallowed wildcard in
+                             * a signature, since we are guaranteed to
+                             * resolve this kind locally during elaboration. *)
+                            | _ => elabKind env k
 
              val (c', ck, gs') = elabCon (env, denv) c
              val (env', n) = E.pushCNamed env x k' (SOME c')
@@ -4756,6 +4763,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) =
-- 
cgit v1.2.3


From abf8a0434cb1c1ab22a50182ffdc6cf0c4645523 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 20 Sep 2019 13:39:07 -0400
Subject: Laxer wildcard restriction for signatures

---
 src/elaborate.sml | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

diff --git a/src/elaborate.sml b/src/elaborate.sml
index c6825150..fbbde303 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -264,14 +264,16 @@
   * 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 f =
+ fun enterSignature' b f =
      let
          val inS = !inSignature
      in
-         inSignature := true;
+         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
@@ -2577,14 +2579,10 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
          let
              val k' = case ko of
                           NONE => kunif env loc
-                        | SOME k =>
-                          case #1 k of
-                              L.KWild => kunif env loc
-                            (* Why duplicate this case of elabKind here?
-                             * To avoid flagging a disallowed wildcard in
-                             * a signature, since we are guaranteed to
-                             * resolve this kind locally during elaboration. *)
-                            | _ => 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')
-- 
cgit v1.2.3


From c388a91762e9dd9aef2eb097963af020c0e452f8 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 21 Sep 2019 08:33:09 -0400
Subject: Desugaring of SQL constraints uses wildcards, so allow that even in
 signatures

---
 src/elaborate.sml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/elaborate.sml b/src/elaborate.sml
index fbbde303..9718ccad 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2734,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''
 
@@ -2742,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'''
 
-- 
cgit v1.2.3


From 8728f397bee2b567611dcd7a7c359c7e92159c1c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 25 Sep 2019 19:54:59 -0400
Subject: Unicode escapes in JSON

---
 include/urweb/urweb_cpp.h |  1 +
 lib/ur/basis.urs          |  1 +
 lib/ur/json.ur            | 29 +++++++++++++++++++++++++++++
 src/c/urweb.c             | 12 ++++++++++++
 4 files changed, 43 insertions(+)

diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index dcf67fef..e4ad6e61 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -166,6 +166,7 @@ uw_Basis_string uw_Basis_strchr(struct uw_context *, const char *, uw_Basis_char
 uw_Basis_int uw_Basis_strcspn(struct uw_context *, const char *, const char *);
 uw_Basis_string uw_Basis_substring(struct uw_context *, const char *, uw_Basis_int, uw_Basis_int);
 uw_Basis_string uw_Basis_str1(struct uw_context *, uw_Basis_char);
+uw_Basis_string uw_Basis_ofUnicode(struct uw_context *, uw_Basis_int);
 
 uw_Basis_string uw_strdup(struct uw_context *, const char *);
 uw_Basis_string uw_maybe_strdup(struct uw_context *, const char *);
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 2a98bf6f..d29bf6e6 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -95,6 +95,7 @@ val strsindex : string -> string -> option int
 val strcspn : string -> string -> int
 val substring : string -> int -> int -> string
 val str1 : char -> string
+val ofUnicode : int -> string
 
 class show
 val show : t ::: Type -> show t -> t -> string
diff --git a/lib/ur/json.ur b/lib/ur/json.ur
index 05406739..70f0c797 100644
--- a/lib/ur/json.ur
+++ b/lib/ur/json.ur
@@ -59,6 +59,17 @@ fun escape s =
         "\"" ^ esc s
     end
 
+fun unhex ch =
+    if Char.isDigit ch then
+        Char.toInt ch - Char.toInt #"0"
+    else if Char.isXdigit ch then
+        if Char.isUpper ch then
+            10 + (Char.toInt ch - Char.toInt #"A")
+        else
+            10 + (Char.toInt ch - Char.toInt #"a")
+    else
+        error <xml>Invalid hexadecimal digit "{[ch]}"</xml>
+    
 fun unescape s =
     let
         val len = String.length s
@@ -75,6 +86,11 @@ fun unescape s =
                       | #"\\" =>
                         if i+1 >= len then
                             error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else if String.sub s (i + 1) = #"u" then
+                            if i+5 >= len then
+                                error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                            else
+                                findEnd (i+6)
                         else
                             findEnd (i+2)
                       | _ => findEnd (i+1)
@@ -93,6 +109,19 @@ fun unescape s =
                         #"\\" =>
                         if i+1 >= len then
                             error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else if String.sub s (i+1) = #"u" then
+                            if i+5 >= len then
+                                error <xml>JSON unescape: Unicode ends early</xml>
+                            else
+                                let
+                                    val n =
+                                        unhex (String.sub s (i+2)) * (256*16)
+                                        + unhex (String.sub s (i+3)) * 256
+                                        + unhex (String.sub s (i+4)) * 16
+                                        + unhex (String.sub s (i+5))
+                                in
+                                    ofUnicode n ^ unesc (i+6)
+                                end
                         else
 			    (case String.sub s (i+1) of
 				 #"n" => "\n"
diff --git a/src/c/urweb.c b/src/c/urweb.c
index af929269..8c445f39 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -2724,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;
-- 
cgit v1.2.3


From 36544aaddd3d904c6b234f39951c9136bf5867ff Mon Sep 17 00:00:00 2001
From: Mark Clements <mark.clements@ki.se>
Date: Fri, 4 Oct 2019 14:24:35 +0200
Subject: Add Step attribute to crange; fix tests for cnumber and crange

---
 lib/ur/basis.urs      | 2 +-
 tests/html5_cforms.ur | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index d29bf6e6..a97c2855 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1074,7 +1074,7 @@ val ctel : ctext
 val ccolor : ctext
 
 val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) []
-val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) []
+val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int, Step = float] ++ boxAttrs ++ inputAttrs) []
 val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
 val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
 val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur
index be07d07e..317a0638 100644
--- a/tests/html5_cforms.ur
+++ b/tests/html5_cforms.ur
@@ -9,8 +9,8 @@ fun main () : transaction page =
     d <- source "";
     e <- source "";
     f <- source "";
-    g <- source 1.0;
-    h <- source 1.0;
+    g <- source (Some 1.0);
+    h <- source (Some 1.0);
     i <- source "#CCCCCC";
     j <- source "2014/11/16";
     k <- source "2014/11/16 12:30:45";
-- 
cgit v1.2.3


From 15495e87cb15591ff895563d90bb77fa1e604585 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 4 Oct 2019 18:12:31 -0400
Subject: JavaScript 'currentUrl' should return a string, not a URL, since the
 latter has a completeley different sort of 'replace' method

---
 lib/js/urweb.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 332de6dc..59e5ad2c 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -3280,7 +3280,7 @@ function confrm(s) {
 }
 
 function currentUrl() {
-    return window.location;
+    return window.location.toString();
 }
 
 
-- 
cgit v1.2.3


From 39bfe4b44542852a656a3793d1f245bf31503b49 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 5 Oct 2019 10:34:33 -0400
Subject: Optimize JSON unescaping for server-side execution

---
 lib/ur/json.ur | 38 +++++++++++++++++++-------------------
 1 file changed, 19 insertions(+), 19 deletions(-)

diff --git a/lib/ur/json.ur b/lib/ur/json.ur
index 70f0c797..e2bdd4df 100644
--- a/lib/ur/json.ur
+++ b/lib/ur/json.ur
@@ -74,56 +74,56 @@ fun unescape s =
     let
         val len = String.length s
 
-        fun findEnd i =
+        fun findEnd i s =
             if i >= len then
                 error <xml>JSON unescape: string ends before quote: {[s]}</xml>
             else
                 let
-                    val ch = String.sub s i
+                    val ch = String.sub s 0
                 in
                     case ch of
                         #"\"" => i
                       | #"\\" =>
                         if i+1 >= len then
                             error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
-                        else if String.sub s (i + 1) = #"u" then
+                        else if String.sub s 1 = #"u" then
                             if i+5 >= len then
                                 error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
                             else
-                                findEnd (i+6)
+                                findEnd (i+6) (String.suffix s 6)
                         else
-                            findEnd (i+2)
-                      | _ => findEnd (i+1)
+                            findEnd (i+2) (String.suffix s 2)
+                      | _ => findEnd (i+1) (String.suffix s 1)
                 end
 
-        val last = findEnd 1
+        val last = findEnd 1 (String.suffix s 1)
 
-        fun unesc i =
+        fun unesc i s =
             if i >= last then
                 ""
             else
                 let
-                    val ch = String.sub s i
+                    val ch = String.sub s 0
                 in
                     case ch of
                         #"\\" =>
                         if i+1 >= len then
                             error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
-                        else if String.sub s (i+1) = #"u" then
+                        else if String.sub s 1 = #"u" then
                             if i+5 >= len then
                                 error <xml>JSON unescape: Unicode ends early</xml>
                             else
                                 let
                                     val n =
-                                        unhex (String.sub s (i+2)) * (256*16)
-                                        + unhex (String.sub s (i+3)) * 256
-                                        + unhex (String.sub s (i+4)) * 16
-                                        + unhex (String.sub s (i+5))
+                                        unhex (String.sub s 2) * (256*16)
+                                        + unhex (String.sub s 3) * 256
+                                        + unhex (String.sub s 4) * 16
+                                        + unhex (String.sub s 5)
                                 in
-                                    ofUnicode n ^ unesc (i+6)
+                                    ofUnicode n ^ unesc (i+6) (String.suffix s 6)
                                 end
                         else
-			    (case String.sub s (i+1) of
+			    (case String.sub s 1 of
 				 #"n" => "\n"
                                | #"r" => "\r"
                                | #"t" => "\t"
@@ -132,14 +132,14 @@ fun unescape s =
 			       | #"/" => "/"
                                | x => error <xml>JSON unescape: Bad escape char: {[x]}</xml>)
 			    ^
-			    unesc (i+2)
-                      | _ => String.str ch ^ unesc (i+1)
+			    unesc (i+2) (String.suffix s 2)
+                      | _ => String.str ch ^ unesc (i+1) (String.suffix s 1)
                 end
     in
         if len = 0 || String.sub s 0 <> #"\"" then
             error <xml>JSON unescape: String doesn't start with double quote: {[s]}</xml>
         else
-            (unesc 1, String.substring s {Start = last+1, Len = len-last-1})
+            (unesc 1 (String.suffix s 1), String.suffix s (last+1))
     end
 
 val json_string = {ToJson = escape,
-- 
cgit v1.2.3


From 56bb940f305fb3d32cc218a6dbc8fa1b1fd7ef89 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Mon, 7 Oct 2019 16:47:39 -0400
Subject: Update urlification of unit values for RPC results, to track a
 previous change elsewhere

---
 src/cjr_print.sml | 59 ++++++++++++++++++++++---------------------------------
 tests/rpc_unit.ur |  8 ++++++++
 2 files changed, 31 insertions(+), 36 deletions(-)
 create mode 100644 tests/rpc_unit.ur

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5dcfbe89..d7b8017e 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)
diff --git a/tests/rpc_unit.ur b/tests/rpc_unit.ur
new file mode 100644
index 00000000..befd6045
--- /dev/null
+++ b/tests/rpc_unit.ur
@@ -0,0 +1,8 @@
+val callme = return ((), (), "A", (), ())
+
+val main : transaction page = return <xml><body>
+  <button value="CLICK ME"
+          onclick={fn _ =>
+                      (_, _, s, _, _) <- rpc callme;
+                      alert s}/>
+</body></xml>
-- 
cgit v1.2.3


From f7b684dbdae9229a69258a7e575395af120d2654 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 11 Oct 2019 15:06:18 -0400
Subject: JSON records with optional fields

---
 lib/ur/json.ur  | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lib/ur/json.urs |  4 +++
 2 files changed, 89 insertions(+)

diff --git a/lib/ur/json.ur b/lib/ur/json.ur
index e2bdd4df..0865ab33 100644
--- a/lib/ur/json.ur
+++ b/lib/ur/json.ur
@@ -287,6 +287,91 @@ fun skipOne s =
         skipOne s False False 0 0
     end
 
+fun json_record_withOptional [ts ::: {Type}] [ots ::: {Type}] [ts ~ ots]
+                             (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts))
+                             (ofl : folder ots) (ojss : $(map json ots)) (onames : $(map (fn _ => string) ots)): json $(ts ++ map option ots) =
+    {ToJson = fn r =>
+                 let
+                     val withRequired =
+                         @foldR3 [json] [fn _ => string] [ident] [fn _ => string]
+                          (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
+                              escape name ^ ":" ^ j.ToJson v ^ (case acc of
+                                                                    "" => ""
+                                                                  | acc => "," ^ acc))
+                          "" fl jss names (r --- _)
+
+                     val withOptional =
+                         @foldR3 [json] [fn _ => string] [option] [fn _ => string]
+                          (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
+                              case v of
+                                  None => acc
+                                | Some v =>
+                                  escape name ^ ":" ^ j.ToJson v ^ (case acc of
+                                                                        "" => ""
+                                                                      | acc => "," ^ acc))
+                          "" ofl ojss onames (r --- _)
+                 in
+                     "{" ^ withOptional ^ "}"
+                 end,
+     FromJson = fn s =>
+                   let
+                       fun fromJ s (r : $(map option (ts ++ ots))) : $(map option (ts ++ ots)) * string =
+                           if String.length s = 0 then
+                               error <xml>JSON object doesn't end in brace</xml>
+                           else if String.sub s 0 = #"}" then
+                               (r, String.substring s {Start = 1, Len = String.length s - 1})
+                           else let
+                                   val (name, s') = unescape s
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
+                                                error <xml>No colon after JSON object field name</xml>
+                                            else
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+
+                                   val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string]
+                                                  (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r =>
+                                                      if name = name' then
+                                                          let
+                                                              val (v, s') = j.FromJson s'
+                                                          in
+                                                              (r -- nm ++ {nm = Some v}, s')
+                                                          end
+                                                      else
+                                                          let
+                                                              val (r', s') = acc (r -- nm)
+                                                          in
+                                                              (r' ++ {nm = r.nm}, s')
+                                                          end)
+                                                  (fn r => (r, skipOne s'))
+                                                  (@Folder.concat ! fl ofl) (jss ++ ojss) (names ++ onames) r
+
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                            else
+                                                s'
+                               in
+                                   fromJ s' r
+                               end
+                   in
+                       if String.length s = 0 || String.sub s 0 <> #"{" then
+                           error <xml>JSON record doesn't begin with brace</xml>
+                       else
+                           let
+                               val (r, s') = fromJ (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1}))
+                                                   (@map0 [option] (fn [t ::_] => None) (@Folder.concat ! fl ofl))
+                           in
+                               (@map2 [option] [fn _ => string] [ident] (fn [t] (v : option t) name =>
+                                                                            case v of
+                                                                                None => error <xml>Missing JSON object field {[name]}</xml>
+                                                                              | Some v => v) fl (r --- _) names
+                                 ++ (r --- _), s')
+                           end
+end}
+
+(* At the moment, the below code is largely copied and pasted from the last
+ * definition, because otherwise the compiler fails to inline enough for
+ * compilation to succeed. *)
 fun json_record [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json $ts =
     {ToJson = fn r => "{" ^ @foldR3 [json] [fn _ => string] [ident] [fn _ => string]
                              (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
diff --git a/lib/ur/json.urs b/lib/ur/json.urs
index b4bd6350..56f5a897 100644
--- a/lib/ur/json.urs
+++ b/lib/ur/json.urs
@@ -17,6 +17,10 @@ val json_option : a ::: Type -> json a -> json (option a)
 val json_list : a ::: Type -> json a -> json (list a)
 
 val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts
+val json_record_withOptional : ts ::: {Type} -> ots ::: {Type} -> [ts ~ ots]
+                               => folder ts -> $(map json ts) -> $(map (fn _ => string) ts)
+                               -> folder ots -> $(map json ots) -> $(map (fn _ => string) ots)
+                               -> json $(ts ++ map option ots)
 val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts)
 
 val json_unit : json unit
-- 
cgit v1.2.3


From b71c7b9ec4580326772a212fbe011322ae1ac063 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 11 Oct 2019 17:18:02 -0400
Subject: JSON instance for times, based on RFC 3339 (because Google APIs use
 it)

---
 lib/ur/json.ur  | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 lib/ur/json.urs |  1 +
 2 files changed, 48 insertions(+)

diff --git a/lib/ur/json.ur b/lib/ur/json.ur
index 0865ab33..58822d4b 100644
--- a/lib/ur/json.ur
+++ b/lib/ur/json.ur
@@ -145,6 +145,53 @@ fun unescape s =
 val json_string = {ToJson = escape,
                    FromJson = unescape}
 
+fun rfc3339_out s =
+    let
+        val out1 = timef "%Y-%m-%dT%H:%M:%S%z" s
+        val len = String.length out1
+    in
+        if len < 2 then
+            error <xml>timef output too short</xml>
+        else
+            String.substring out1 {Start = 0, Len = len - 2} ^ ":"
+            ^ String.suffix out1 (len - 2)
+    end
+
+fun rfc3339_in s =
+    case String.split s #"T" of
+        None => error <xml>Invalid RFC 3339 string "{[s]}"</xml>
+      | Some (date, time) =>
+        case String.msplit {Haystack = time, Needle = "Z+-"} of
+            None => error <xml>Invalid RFC 3339 string "{[s]}"</xml>
+          | Some (time, sep, rest) =>
+            let
+                val t = case readUtc (date ^ " " ^ time) of
+                            None => error <xml>Invalid RFC 3339 string "{[s]}"</xml>
+                          | Some t => t
+
+                fun withOffset multiplier =
+                    case String.split rest #":" of
+                        None => error <xml>Invalid RFC 3339 string "{[s]}"</xml>
+                      | Some (h, m) =>
+                        case (read h, read m) of
+                            (Some h, Some m) => addSeconds t (multiplier * 60 * (60 * h + m))
+                          | _ => error <xml>Invalid RFC 3339 string "{[s]}"</xml>
+            in
+                case sep of
+                    #"Z" => t
+                  | #"+" => withOffset (-1)
+                  | #"-" => withOffset 1
+                  | _ => error <xml>msplit returns impossible separator</xml>
+            end
+
+val json_time = {ToJson = fn tm => escape (rfc3339_out tm),
+                 FromJson = fn s =>
+                               let
+                                   val (v, s') = unescape s
+                               in
+                                   (rfc3339_in v, s')
+                               end}
+
 fun numIn [a] (_ : read a) s : a * string =
     let
         val len = String.length s
diff --git a/lib/ur/json.urs b/lib/ur/json.urs
index 56f5a897..7b83d03d 100644
--- a/lib/ur/json.urs
+++ b/lib/ur/json.urs
@@ -13,6 +13,7 @@ val json_string : json string
 val json_int : json int
 val json_float : json float
 val json_bool : json bool
+val json_time : json time
 val json_option : a ::: Type -> json a -> json (option a)
 val json_list : a ::: Type -> json a -> json (list a)
 
-- 
cgit v1.2.3


From 404429ca9197a508efc1be5425d6fc4a00a5eae9 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 13 Oct 2019 14:50:16 -0400
Subject: Undo a questionable optimization, almost 10 years later (closes #179)

---
 src/mono_reduce.sml |  3 +--
 tests/tooEager.ur   | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+), 2 deletions(-)
 create mode 100644 tests/tooEager.ur

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/tests/tooEager.ur b/tests/tooEager.ur
new file mode 100644
index 00000000..c84a6d6c
--- /dev/null
+++ b/tests/tooEager.ur
@@ -0,0 +1,18 @@
+fun test (i: list int) : transaction unit =
+    a <- return (Some "abc");
+    c <- (case a of
+            None => return "1"
+          | Some b =>
+            debug "not happening :(";
+            return "2"
+         );
+    (case i of
+       [] => return ()
+     | first :: _ => debug c)
+
+fun main (): transaction page =
+    return <xml>
+      <body>
+        <button onclick={fn _ => rpc (test [])}>click</button>
+      </body>
+    </xml>
-- 
cgit v1.2.3


From ce9b6ef5ec667d474f6e6644046b27905441660a Mon Sep 17 00:00:00 2001
From: Simon Van Casteren <simon.van.casteren@gmail.com>
Date: Mon, 4 Nov 2019 14:50:56 +0100
Subject: Fix for #181: unurlify x-www-form-urlencoded without custom
 serialization using period

---
 src/c/urweb.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 8c445f39..a01b4aae 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4941,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");
-- 
cgit v1.2.3


From 73c287964e8d41d9b3b53a81f0ace3f509dc6a20 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 8 Nov 2019 16:16:14 -0500
Subject: Json: expose RFC 3339 functions

---
 lib/ur/json.urs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/lib/ur/json.urs b/lib/ur/json.urs
index 7b83d03d..ad49a40f 100644
--- a/lib/ur/json.urs
+++ b/lib/ur/json.urs
@@ -17,6 +17,11 @@ val json_time : json time
 val json_option : a ::: Type -> json a -> json (option a)
 val json_list : a ::: Type -> json a -> json (list a)
 
+(* By the way, time formatting follows RFC 3339, and we expose the more
+ * primitive formatting functions here. *)
+val rfc3339_out : time -> string
+val rfc3339_in : string -> time
+
 val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts
 val json_record_withOptional : ts ::: {Type} -> ots ::: {Type} -> [ts ~ ots]
                                => folder ts -> $(map json ts) -> $(map (fn _ => string) ts)
-- 
cgit v1.2.3


From 2bca6e48c0ea8043c5300f4ebdefa5167e6472bf Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 4 Dec 2019 09:19:55 -0500
Subject: SQL SIMILAR (via pg_trgm)

---
 lib/ur/basis.urs   | 10 ++++++++++
 src/cjr.sml        |  2 +-
 src/cjr_print.sml  | 21 +++++++++++++++++----
 src/mono.sml       |  2 +-
 src/mono_print.sml | 21 +++++++++++----------
 src/monoize.sml    | 49 +++++++++++++++++++++++++++++++++++++++++++++++--
 src/mysql.sml      |  3 ++-
 src/postgres.sml   |  5 +++--
 src/settings.sig   |  3 ++-
 src/settings.sml   |  6 ++++--
 src/sqlite.sml     |  3 ++-
 src/urweb.grm      |  9 +++++++++
 tests/filter.urp   |  1 +
 tests/trgm.ur      | 25 +++++++++++++++++++++++++
 tests/trgm.urp     |  6 ++++++
 tests/trgm.urs     |  1 +
 16 files changed, 142 insertions(+), 25 deletions(-)
 create mode 100644 tests/trgm.ur
 create mode 100644 tests/trgm.urp
 create mode 100644 tests/trgm.urs

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index a97c2855..dda48d2b 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -623,6 +623,16 @@ val sql_known : t ::: Type -> sql_ufunc t bool
 val sql_lower : sql_ufunc string string
 val sql_upper : sql_ufunc string string
 
+con sql_bfunc :: Type -> Type -> Type -> Type
+val sql_bfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> dom1 ::: Type -> dom2 ::: Type -> ran ::: Type
+                -> sql_bfunc dom1 dom2 ran
+                -> sql_exp tables agg exps dom1
+                -> sql_exp tables agg exps dom2
+                -> sql_exp tables agg exps ran
+val sql_similarity : sql_bfunc string string float
+(* Only supported by Postgres for now, via the pg_trgm module *)
+
 val sql_nullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
                    -> sql_injectable_prim t
                    -> sql_exp tables agg exps t
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 d7b8017e..70ebdf43 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3230,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
@@ -3753,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
@@ -3837,6 +3840,9 @@ fun p_sql env (ds, _) =
                                                  string ";",
                                                  newline,
                                                  newline]
+                                          | DDatabase {usesSimilar = s, ...} =>
+                                            (usesSimilar := s;
+                                             box [])
                                           | _ => box []
                            in
                                (pp, E.declBinds env dAll)
@@ -3849,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/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/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/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)
diff --git a/tests/filter.urp b/tests/filter.urp
index 102a1871..ddf1a3df 100644
--- a/tests/filter.urp
+++ b/tests/filter.urp
@@ -1,4 +1,5 @@
 debug
 database dbname=filter
+sql filter.sql
 
 filter
diff --git a/tests/trgm.ur b/tests/trgm.ur
new file mode 100644
index 00000000..45783366
--- /dev/null
+++ b/tests/trgm.ur
@@ -0,0 +1,25 @@
+table turtles : { Nam : string }
+
+fun add name =
+    dml (INSERT INTO turtles(Nam)
+         VALUES ({[name]}))
+
+fun closest name =
+    List.mapQuery (SELECT *
+                   FROM turtles
+                   ORDER BY similarity(turtles.Nam, {[name]}) DESC
+                   LIMIT 5)
+                  (fn r => r.Turtles.Nam)
+
+val main =
+    name <- source "";
+    results <- source [];
+    return <xml><body>
+      Name: <ctextbox source={name}/><br/>
+      <button value="Add" onclick={fn _ => n <- get name; rpc (add n)}/><br/>
+      <button value="Search" onclick={fn _ => n <- get name; ls <- rpc (closest n); set results ls}/><br/>
+      <dyn signal={rs <- signal results;
+                   return <xml><ol>
+                     {List.mapX (fn n => <xml><li>{[n]}</li></xml>) rs}
+                   </ol></xml>}/>
+    </body></xml>
diff --git a/tests/trgm.urp b/tests/trgm.urp
new file mode 100644
index 00000000..326151e7
--- /dev/null
+++ b/tests/trgm.urp
@@ -0,0 +1,6 @@
+database dbname=trgm
+sql trgm.sql
+rewrite all Trgm/*
+
+$/list
+trgm
diff --git a/tests/trgm.urs b/tests/trgm.urs
new file mode 100644
index 00000000..61778b87
--- /dev/null
+++ b/tests/trgm.urs
@@ -0,0 +1 @@
+val main : transaction page
-- 
cgit v1.2.3