Merge.

20 files changed, 405 insertions, 157 deletions

diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c
index f3e66e3a..cda3e1f6 100644
--- a/src/c/fastcgi.c
+++ b/src/c/fastcgi.c
@@ -333,7 +333,7 @@ static void *worker(void *data) {
   size_t path_size = 0;
   char *path_buf = malloc(0);
 
-  hs.uppercased = malloc(0);
+  hs.uppercased = malloc(6);
   hs.uppercased_len = 0;
   hs.nvps = malloc(sizeof(nvp));
   hs.n_nvps = 1;
diff --git a/src/c/openssl.c b/src/c/openssl.c
index 6a998e29..1d820a34 100644
--- a/src/c/openssl.c
+++ b/src/c/openssl.c
@@ -9,6 +9,7 @@
 #include <string.h>
 
 #include <openssl/sha.h>
+#include <openssl/rand.h>
 
 #define PASSSIZE 4
 
@@ -19,10 +20,11 @@ static int password[PASSSIZE];
 char *uw_sig_file = NULL;
 
 static void random_password() {
-  int i;
-
-  for (i = 0; i < PASSSIZE; ++i)
-    password[i] = rand();
+  if (!RAND_bytes((unsigned char *)password, sizeof password)) {
+    fprintf(stderr, "Error generating random password\n");
+    perror("RAND_bytes");
+    exit(1);
+  }
 }
 
 void uw_init_crypto() {
diff --git a/src/c/urweb.c b/src/c/urweb.c
index d01cfaa2..53344c5e 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -167,6 +167,19 @@ void *uw_init_client_data();
 void uw_free_client_data(void *);
 void uw_copy_client_data(void *dst, void *src);
 
+static pthread_mutex_t rand_mutex = PTHREAD_MUTEX_INITIALIZER;
+
+static uw_Basis_int my_rand() {
+  pthread_mutex_lock(&rand_mutex);
+  int ret, r = RAND_bytes((unsigned char *)&ret, sizeof ret);
+  pthread_mutex_unlock(&rand_mutex);
+
+  if (r)
+    return abs(ret);
+  else
+    return -1;
+}
+
 static client *new_client() {
   client *c;
 
@@ -192,7 +205,7 @@ static client *new_client() {
 
   pthread_mutex_lock(&c->lock);
   c->mode = USED;
-  c->pass = rand();
+  c->pass = my_rand();
   c->sock = -1;
   c->last_contact = time(NULL);
   uw_buffer_reset(&c->msgs);
@@ -349,8 +362,6 @@ extern void uw_global_custom();
 extern void uw_init_crypto();
 
 void uw_global_init() {
-  srand(time(NULL) ^ getpid());
-
   clients = malloc(0);
 
   uw_global_custom();
@@ -4234,16 +4245,11 @@ uw_Basis_unit uw_Basis_debug(uw_context ctx, uw_Basis_string s) {
   return uw_unit_v;
 }
 
-static pthread_mutex_t rand_mutex = PTHREAD_MUTEX_INITIALIZER;
-
 uw_Basis_int uw_Basis_rand(uw_context ctx) {
-  uw_Basis_int ret;
-  pthread_mutex_lock(&rand_mutex);
-  int r = RAND_bytes((unsigned char *)&ret, sizeof ret);
-  pthread_mutex_unlock(&rand_mutex);
+  int r = my_rand();
 
-  if (r)
-    return abs(ret);
+  if (r >= 0)
+    return r;
   else
     uw_error(ctx, FATAL, "Random number generation failed");
 }
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 73e0316d..1b1d656d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3260,6 +3260,16 @@ fun p_file env (ds, ps) =
                                                               string "))"]))
                          NONE cookies
 
+        val cookieCode = foldl (fn (evar, acc) =>
+                                   SOME (case acc of
+                                             NONE => string ("uw_unnull(uw_Basis_getenv(ctx, \""
+                                                             ^ Prim.toCString evar ^ "\"))")
+                                           | SOME acc => box [string ("uw_Basis_strcat(ctx, uw_unnull(uw_Basis_getenv(ctx, \""
+                                                                      ^ Prim.toCString evar ^ "\")), uw_Basis_strcat(ctx, \"/\", "),
+                                                              acc,
+                                                              string "))"]))
+                         cookieCode (SideCheck.readEnvVars ())
+
         fun makeChecker (name, rules : Settings.rule list) =
             box [string "static int ",
                  string name,
diff --git a/src/compiler.sml b/src/compiler.sml
index fc4067a4..a45b8c69 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -461,14 +461,13 @@ fun parseUrp' accLibs fname =
          end
      else
          let
-             val thisPath = OS.Path.dir fname
-
              val pathmap = ref (!pathmap)
              val bigLibs = ref []
 
              fun pu filename =
                  let
                      val filename = OS.Path.mkAbsolute {path = filename, relativeTo = OS.FileSys.getDir ()}
+                     val thisPath = OS.Path.dir filename
 
                      val dir = OS.Path.dir filename
                      fun opener () = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
@@ -693,8 +692,8 @@ fun parseUrp' accLibs fname =
                            | _ => (ErrorMsg.error "Bad path kind spec";
                                    Settings.Any)
 
-                     fun parseFrom s =
-                         if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
+                     fun parsePattern s =
+                         if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
                              (Settings.Prefix, String.substring (s, 0, size s - 1))
                          else
                              (Settings.Exact, s)
@@ -709,12 +708,6 @@ fun parseUrp' accLibs fname =
                            | _ => (ErrorMsg.error "Bad filter kind";
                                    url)
 
-                     fun parsePattern s =
-                         if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
-                             (Settings.Prefix, String.substring (s, 0, size s - 1))
-                         else
-                             (Settings.Exact, s)
-
                      fun read () =
                          case inputCommentableLine inf of
                              EndOfFile => finish []
@@ -801,7 +794,7 @@ fun parseUrp' accLibs fname =
                                          fun doit (pkind, from, to, hyph) =
                                              let
                                                  val pkind = parsePkind pkind
-                                                 val (kind, from) = parseFrom from
+                                                 val (kind, from) = parsePattern from
                                              in
                                                  rewrites := {pkind = pkind, kind = kind, from = from, to = to, hyphenate = hyph} :: !rewrites
                                              end
diff --git a/src/effectize.sml b/src/effectize.sml
index d711e620..2c9b2374 100644
--- a/src/effectize.sml
+++ b/src/effectize.sml
@@ -79,6 +79,8 @@ fun effectize file =
         fun exp evs e =
             case e of
                 EFfi ("Basis", "getCookie") => true
+              | EFfiApp ("Basis", "getHeader", _) => true
+              | EFfiApp ("Basis", "getenv", _) => true
               | ENamed n => IM.inDomain (evs, n)
               | EServerCall (n, _, _, _) => IM.inDomain (evs, n)
               | _ => false
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 749bd2f1..5b18ae94 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2015,6 +2015,45 @@ fun chaseUnifs c =
         L'.CUnif (_, _, _, _, ref (L'.Known c)) => chaseUnifs c
       | _ => c
 
+val consEqSimple =
+    let
+        fun ces env (c1 : L'.con, c2 : L'.con) =
+            let
+                val c1 = hnormCon env c1
+                val c2 = hnormCon env c2
+            in
+                case (#1 c1, #1 c2) of
+                    (L'.CRel n1, L'.CRel n2) => n1 = n2
+                  | (L'.CNamed n1, L'.CNamed n2) =>
+                    n1 = n2 orelse
+                    (case #3 (E.lookupCNamed env n1) of
+                         SOME (L'.CNamed n2', _) => n2' = n1
+                       | _ => false)
+                  | (L'.CModProj n1, L'.CModProj n2) => n1 = n2
+                  | (L'.CApp (f1, x1), L'.CApp (f2, x2)) => ces env (f1, f2) andalso ces env (x1, x2)
+                  | (L'.CAbs (x1, k1, c1), L'.CAbs (_, _, c2)) => ces (E.pushCRel env x1 k1) (c1, c2)
+                  | (L'.CName x1, L'.CName x2) => x1 = x2
+                  | (L'.CRecord (_, xts1), L'.CRecord (_, xts2)) =>
+                    ListPair.all (fn ((x1, t1), (x2, t2)) =>
+                                     ces env (x1, x2) andalso ces env (t2, t2)) (xts1, xts2)
+                  | (L'.CConcat (x1, y1), L'.CConcat (x2, y2)) =>
+                    ces env (x1, x2) andalso ces env (y1, y2)
+                  | (L'.CMap _, L'.CMap _) => true
+                  | (L'.CUnit, L'.CUnit) => true
+                  | (L'.CTuple cs1, L'.CTuple cs2) => ListPair.all (ces env) (cs1, cs2)
+                  | (L'.CProj (c1, n1), L'.CProj (c2, n2)) => ces env (c1, c2) andalso n1 = n2
+                  | (L'.CUnif (_, _, _, _, r1), L'.CUnif (_, _, _, _, r2)) => r1 = r2
+
+                  | (L'.TFun (d1, r1), L'.TFun (d2, r2)) => ces env (d1, d2) andalso ces env (r1, r2)
+                  | (L'.TRecord c1, L'.TRecord c2) => ces env (c1, c2)
+                  
+                  | _ => false
+            end
+    in
+        ces
+    end
+    
+
 fun elabExp (env, denv) (eAll as (e, loc)) =
     let
         (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)]*)
@@ -3020,26 +3059,7 @@ and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
 
       | (L'.SgnConst sgis1, L'.SgnConst sgis2) =>
         let
-            (* This reshuffling was added to avoid some unfortunate unification behavior.
-             * In particular, in sub-signature checking, constraints might be unified,
-             * even when we don't expect them to be unifiable, deciding on bad values
-             * for unification variables and dooming later unification.
-             * By putting all the constraints _last_, we allow all the other unifications
-             * to happen first, hoping that no unification variables survive to confuse
-             * constraint unification. *)
-
-            val sgis2 =
-                let
-                    val (constraints, others) = List.partition
-                                                   (fn (L'.SgiConstraint _, _) => true
-                                                   | _ => false) sgis2
-                in
-                    case constraints of
-                        [] => sgis2
-                      | _ => others @ constraints
-                end
-
-            (*val () = prefaces "subSgn" [("sgn1", p_sgn env sgn1),
+           (*val () = prefaces "subSgn" [("sgn1", p_sgn env sgn1),
                                         ("sgn2", p_sgn env sgn2),
                                         ("sgis1", p_sgn env (L'.SgnConst sgis1, loc2)),
                                         ("sgis2", p_sgn env (L'.SgnConst sgis2, loc2))]*)
@@ -3329,7 +3349,12 @@ and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
                                      L'.SgiStr (x', n1, sgn1) =>
                                      if x = x' then
                                          let
+                                             (* Don't forget to save & restore the
+                                              * counterparts map around recursive calls!
+                                              * Otherwise, all sorts of mayhem may result. *)
+                                             val saved = !counterparts
                                              val () = subSgn' counterparts env loc sgn1 sgn2
+                                             val () = counterparts := saved
                                              val env = E.pushStrNamedAs env x n1 sgn1
                                              val env = if n1 = n2 then
                                                            env
@@ -3370,8 +3395,11 @@ and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
                         seek (fn (env, sgi1All as (sgi1, loc)) =>
                                  case sgi1 of
                                      L'.SgiConstraint (c1, d1) =>
-                                     if consEq env loc (c1, c2)
-					andalso consEq env loc (d1, d2) then
+                                     (* It's important to do only simple equality checking here,
+                                      * with no unification, because constraints are unnamed.
+                                      * It's too easy to pick the wrong pair to unify! *)
+                                     if consEqSimple env (c1, c2)
+					andalso consEqSimple env (d1, d2) then
                                          SOME env
                                      else
                                          NONE
@@ -3669,6 +3697,21 @@ and wildifyStr env (str, sgn) =
 
                        | c => ((*Print.preface ("WTF?", p_con env (c, loc));*) NONE)
 
+                 fun isClassOrFolder' env (c : L'.con) =
+                     case #1 c of
+                         L'.CAbs (x, k, c) =>
+                         let
+                             val env = E.pushCRel env x k
+
+                             fun toHead (c : L'.con) =
+                                 case #1 c of
+                                     L'.CApp (c, _) => toHead c
+                                   | _ => isClassOrFolder env c
+                         in
+                             toHead (hnormCon env c)
+                         end
+                       | _ => isClassOrFolder env c
+
                  fun buildNeeded env sgis =
                      #1 (foldl (fn ((sgi, loc), (nd, env')) =>
                                    (case sgi of
@@ -3680,19 +3723,23 @@ and wildifyStr env (str, sgn) =
                                             fun should t =
                                                 let
                                                     val t = normClassConstraint env' t
+
+                                                    fun shouldR c =
+                                                        case hnormCon env' c of
+                                                            (L'.CApp (f, _), _) =>
+                                                            (case hnormCon env' f of
+                                                                 (L'.CApp (f, cl), loc) =>
+                                                                 (case hnormCon env' f of
+                                                                      (L'.CMap _, _) => isClassOrFolder' env' cl
+                                                                    | _ => false)
+                                                               | _ => false)
+                                                            | (L'.CConcat (c1, c2), _) =>
+                                                              shouldR c1 orelse shouldR c2
+                                                            | c => false
                                                 in
                                                     case #1 t of
                                                         L'.CApp (f, _) => isClassOrFolder env' f
-                                                      | L'.TRecord t =>
-                                                        (case hnormCon env' t of
-                                                             (L'.CApp (f, _), _) =>
-                                                             (case hnormCon env' f of
-                                                                  (L'.CApp (f, cl), loc) =>
-                                                                  (case hnormCon env' f of
-                                                                       (L'.CMap _, _) => isClassOrFolder env' cl
-                                                                     | _ => false)
-                                                                | _ => false)
-                                                           | _ => false)
+                                                      | L'.TRecord t => shouldR t
                                                       | _ => false
                                                 end
                                          in
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index edbff1b0..fb9d18b5 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -171,42 +171,47 @@ See doc for the variable `urweb-mode-info'."
           (depth 0)
           (finished nil)
           (answer nil)
+          (bound (max 0 (- (point) 1024)))
           )
-      (while (and (not finished) (re-search-backward "[-<{}]" nil t))
-        (cond
-         ((looking-at "{")
-          (if (> depth 0)
-              (decf depth)
-            (setq finished t)))
-         ((looking-at "}")
-          (incf depth))
-         ((looking-at "<xml>")
-          (if (> depth 0)
-              (decf depth)
-            (progn
-              (setq answer t)
-              (setq finished t))))
-         ((looking-at "</xml>")
-          (incf depth))
-
-         ((looking-at "-")
-          (if (looking-at "->")
-            (setq finished (= depth 0))))
-
-         ((and (= depth 0)
-               (not (looking-at "<xml")) ;; ignore <xml/>
-               (eq font-lock-tag-face
-                   (get-text-property (point) 'face)))
-          ;; previous code was highlighted as tag, seems we are in xml
-          (progn
-            (setq answer t)
-            (setq finished t)))
-
-         ((= depth 0)
-          ;; previous thing was a tag like, but not tag
-          ;; seems we are in usual code or comment
-          (setq finished t))
-         ))
+      (while (and (not finished)
+                  (re-search-backward "\\(\\([-{}]\\)\\|<\\(/?xml\\)?\\)"
+                                      bound t))
+        (let ((xml-tag (length (or (match-string 3) "")))
+              (ch (match-string 2)))
+         (cond
+          ((equal ch ?\{)
+           (if (> depth 0)
+               (decf depth)
+             (setq finished t)))
+          ((equal ch ?\})
+           (incf depth))
+          ((= xml-tag 3)
+           (if (> depth 0)
+               (decf depth)
+             (progn
+               (setq answer t)
+               (setq finished t))))
+          ((= xml-tag 4)
+           (incf depth))
+
+          ((equal ch ?-)
+           (if (looking-at "->")
+               (setq finished (= depth 0))))
+
+          ((and (= depth 0)
+                (not (looking-at "<xml")) ;; ignore <xml/>
+                (eq font-lock-tag-face
+                    (get-text-property (point) 'face)))
+           ;; previous code was highlighted as tag, seems we are in xml
+           (progn
+             (setq answer t)
+             (setq finished t)))
+
+          ((= depth 0)
+           ;; previous thing was a tag like, but not tag
+           ;; seems we are in usual code or comment
+           (setq finished t))
+          )))
       answer)))
 
 (defun amAttribute (face)
diff --git a/src/jscomp.sml b/src/jscomp.sml
index a4ee95f0..e5f7d234 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -724,6 +724,8 @@ fun process (file : file) =
                                              | "<" => "lt"
                                              | "<=" => "le"
                                              | "strcmp" => "strcmp"
+                                             | "powl" => "pow"
+                                             | "powf" => "pow"
                                              | _ => raise Fail ("Jscomp: Unknown binary operator " ^ s)
 
                                 val (e1, st) = jsE inner (e1, st)
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 22ee36fc..f4cd6895 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -633,6 +633,8 @@ fun exp e =
         EFfiApp ("Basis", "writec", [e])
 
       | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
+      | EBinop (_, "-", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.- (n1, n2)))
+      | EBinop (_, "*", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.* (n1, n2)))
 
       | _ => e
 
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 8ca84c15..61866af7 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -330,7 +330,9 @@ val freeInAbs = U.Exp.existsB {typ = fn _ => false,
                                              U.Exp.RelE _ => n + 1
                                            | _ => n} 0
 
-fun reduce (file : file) =
+val yankedCase = ref false
+
+fun reduce' (file : file) =
     let
         val (timpures, impures, absCounts) =
             foldl (fn ((d, _), (timpures, impures, absCounts)) =>
@@ -770,17 +772,18 @@ fun reduce (file : file) =
                                                                       Print.PD.string "}"]
                                     in
                                         if List.all (safe o #2) pes then
-                                            EAbs ("y", dom, result,
-                                                  (ECase (liftExpInExp 0 e',
-                                                          map (fn (p, (EAbs (_, _, _, e), _)) =>
-                                                                  (p, swapExpVarsPat (0, patBinds p) e)
-                                                                | (p, (EError (e, (TFun (_, t), _)), loc)) =>
-                                                                  (p, (EError (liftExpInExp (patBinds p) e, t), loc))
-                                                                | (p, e) =>
-                                                                  (p, (EApp (liftExpInExp (patBinds p) e,
-                                                                             (ERel (patBinds p), loc)), loc)))
-                                                              pes,
-                                                          {disc = disc, result = result}), loc))
+                                            (yankedCase := true;
+                                             EAbs ("y", dom, result,
+                                                   (ECase (liftExpInExp 0 e',
+                                                           map (fn (p, (EAbs (_, _, _, e), _)) =>
+                                                                   (p, swapExpVarsPat (0, patBinds p) e)
+                                                               | (p, (EError (e, (TFun (_, t), _)), loc)) =>
+                                                                 (p, (EError (liftExpInExp (patBinds p) e, t), loc))
+                                                               | (p, e) =>
+                                                                 (p, (EApp (liftExpInExp (patBinds p) e,
+                                                                            (ERel (patBinds p), loc)), loc)))
+                                                               pes,
+                                                           {disc = disc, result = result}), loc)))
                                         else
                                             e
                                     end
@@ -818,10 +821,19 @@ fun reduce (file : file) =
                                 search pes
                         end
 
-                      | EField ((ERecord xes, _), x) =>
-                        (case List.find (fn (x', _, _) => x' = x) xes of
-                             SOME (_, e, _) => #1 e
-                           | NONE => e)
+                      | EField (e1, x) =>
+                        let
+                            fun yankLets (e : exp) =
+                                case #1 e of
+                                    ELet (x, t, e1, e2) => (ELet (x, t, e1, yankLets e2), #2 e)
+                                  | ERecord xes =>
+                                    (case List.find (fn (x', _, _) => x' = x) xes of
+                                         SOME (_, e, _) => e
+                                       | NONE => (EField (e, x), #2 e))
+                                  | _ => (EField (e, x), #2 e)
+                        in
+                            #1 (yankLets e1)
+                        end
 
                       | ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) =>
                         let
@@ -885,4 +897,16 @@ fun reduce (file : file) =
         U.File.mapB {typ = typ, exp = exp, decl = decl, bind = bind} E.empty file
     end
 
+fun reduce file =
+    let
+        val () = yankedCase := false
+        val file' = reduce' file
+    in
+        if !yankedCase then
+            reduce file'
+        else
+            file'
+    end
+
+
 end
diff --git a/src/monoize.sml b/src/monoize.sml
index 4034e3ed..d1513ea6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -89,7 +89,6 @@ val singletons = SS.addList (SS.empty,
                               "p",
                               "hr",
                               "input",
-                              "button",
                               "img",
                               "base",
                               "meta",
@@ -3279,6 +3278,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                     else
                         (NONE, NONE, attrs)
 
+                val (class, fm) = monoExp (env, st, fm) class
+                val (dynClass, fm) = monoExp (env, st, fm) dynClass
+                val (style, fm) = monoExp (env, st, fm) style
+                val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
+
                 (* Special case for <button value=""> *)
                 val (attrs, extraString) = case tag of
                                                "button" =>
@@ -3286,14 +3290,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                     ([(_, value, _)], rest) =>
                                                     (rest, SOME value)
                                                   | _ => (attrs, NONE))
+                                             | "body" =>
+                                               (attrs,
+                                                if (case (#1 dynClass, #1 dynStyle) of
+                                                        (L'.ESome _, _) => true
+                                                      | (_, L'.ESome _) => true
+                                                      | _ => false) then
+                                                    let
+                                                        fun jsify (e : L'.exp) =
+                                                            case #1 e of
+                                                                L'.ESome (_, ds) => strcat [str "execD(",
+                                                                                            (L'.EJavaScript (L'.Script, ds), loc),
+                                                                                            str ")"]
+                                                              | _ => str "null"
+                                                    in
+                                                        SOME (strcat [str "<script type=\"text/javascript\">bodyDynClass(",
+                                                                      jsify dynClass,
+                                                                      str ",",
+                                                                      jsify dynStyle,
+				                                      str ")</script>"])
+                                                    end
+                                                else
+                                                    NONE)
                                              | _ => (attrs, NONE)
 
 
-                val (class, fm) = monoExp (env, st, fm) class
-                val (dynClass, fm) = monoExp (env, st, fm) dynClass
-                val (style, fm) = monoExp (env, st, fm) style
-                val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
-
                 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
 
                 fun isSome (e, _) =
@@ -3458,6 +3479,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                            NONE => tagStart
                                          | SOME extra => (L'.EStrcat (tagStart, extra), loc)
 
+                        val firstWord = Substring.string o #1 o Substring.splitl (fn ch => not (Char.isSpace ch)) o Substring.full
+
                         fun normal () =
                             let
                                 val (xml, fm) = monoExp (env, st, fm) xml
@@ -3468,7 +3491,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             in
                                 ((L'.EStrcat ((L'.EStrcat (tagStart, strH ">"), loc),
                                               (L'.EStrcat (xml,
-                                                           strH (String.concat ["</", tag, ">"])), loc)),
+                                                           strH (String.concat ["</", firstWord tag, ">"])), loc)),
                                   loc),
                                  fm)
                             end
@@ -3835,10 +3858,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                       | "tabl" => normal ("table", NONE)
                       | _ => normal (tag, NONE)
+
+                val (dynClass', dynStyle') =
+                    case tag of
+                        "body" => ((L'.ENone dummyTyp, ErrorMsg.dummySpan),
+                                   (L'.ENone dummyTyp, ErrorMsg.dummySpan))
+                      | _ => (dynClass, dynStyle)
 	    in
-		case #1 dynClass of
+		case #1 dynClass' of
 		    L'.ENone _ =>
-		    (case #1 dynStyle of
+		    (case #1 dynStyle' of
 		         L'.ENone _ => baseAll
 		       | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"",
                                                       str (pnode ()),
@@ -3852,7 +3881,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                baseAll))
 		  | L'.ESome (_, dc) =>
                     let
-                        val e = case #1 dynStyle of
+                        val e = case #1 dynStyle' of
                                     L'.ENone _ => str "null"
                                   | L'.ESome (_, ds) => strcat [str "execD(",
                                                                 (L'.EJavaScript (L'.Script, ds), loc),
diff --git a/src/mysql.sml b/src/mysql.sml
index 29a8c68f..bb654fee 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -446,7 +446,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                       newline,
                       newline,
 
-                      p_list_sepi newline (fn i => fn (s, n) =>
+                      p_list_sepi newline (fn i => fn (s, _) =>
                                                       let
                                                           fun uhoh this s args =
                                                               box [p_list_sepi (box [])
diff --git a/src/postgres.sml b/src/postgres.sml
index b97226c1..6df0331a 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -340,14 +340,12 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                   newline,
                   newline,
 
-                  p_list_sepi newline (fn i => fn (s, n) =>
+                  p_list_sepi newline (fn i => fn (s, _) =>
                                                   box [string "res = PQprepare(conn, \"uw",
                                                        string (Int.toString i),
                                                        string "\", \"",
                                                        string (Prim.toCString s),
-                                                       string "\", ",
-                                                       string (Int.toString n),
-                                                       string ", NULL);",
+                                                       string "\", 0, NULL);",
                                                        newline,
                                                        string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
                                                        newline,
diff --git a/src/settings.sml b/src/settings.sml
index 81c33c08..bd958e22 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -297,6 +297,8 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("mouseEvent", "uw_mouseEvent"),
                           ("keyEvent", "uw_keyEvent"),
                           ("minTime", "0"),
+                          ("stringToBool_error", "s2be"),
+                          ("stringToBool", "s2b"),
 
                           ("islower", "isLower"),
                           ("isupper", "isUpper"),
@@ -378,6 +380,22 @@ type rule = { action : action, kind : pattern_kind, pattern : string }
 datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
 type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
 
+fun pak2s pak =
+    case pak of
+        Exact => "Exact"
+      | Prefix => "Prefix"
+fun pk2s pk =
+    case pk of
+        Any => "Any"
+      | Url => "Url"
+      | Table => "Table"
+      | Sequence => "Sequence"
+      | View => "View"
+      | Relation => "Relation"
+      | Cookie => "Cookie"
+      | Style => "Style"
+fun r2s (r : rewrite) = pak2s (#kind r) ^ " " ^ pk2s (#pkind r) ^ ", from<" ^ #from r ^ ">, to<" ^ #to r ^ ">"
+
 val rewrites = ref ([] : rewrite list)
 
 fun subsume (pk1, pk2) =
@@ -726,15 +744,46 @@ fun capitalize s =
         "" => ""
       | _ => str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
 
+val allLower = CharVector.map Char.toLower
+
 val mangle = ref true
 fun setMangleSql x = mangle := x
-fun mangleSqlTable s = if !mangle then "uw_" ^ capitalize s
-                       else if #name (currentDbms ()) = "mysql" then capitalize s
-                       else lowercase s
-fun mangleSql s = if !mangle then "uw_" ^ s
-                  else if #name (currentDbms ()) = "mysql" then lowercase s
-                  else lowercase s
-fun mangleSqlCatalog s = if !mangle then "uw_" ^ s else lowercase s
+
+fun mangleSqlTable s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ capitalize s
+        else
+            lowercase s
+
+fun mangleSql s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s 
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ s
+        else
+            lowercase s
+
+fun mangleSqlCatalog s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ s
+        else
+            lowercase s
 
 val html5 = ref false
 fun setIsHtml5 b = html5 := b
@@ -822,7 +871,7 @@ fun setFilePath path = filePath := path
 
 fun addFile {Uri, LoadFromFilename} =
     let
-        val path = OS.Path.joinDirFile {dir = !filePath, file = LoadFromFilename}
+        val path = OS.Path.mkAbsolute {relativeTo = !filePath, path = LoadFromFilename}
     in
         case SM.find (!files, Uri) of
             SOME (path', _) =>
diff --git a/src/sidecheck.sig b/src/sidecheck.sig
index 30abced6..1e3e2275 100644
--- a/src/sidecheck.sig
+++ b/src/sidecheck.sig
@@ -29,4 +29,9 @@ signature SIDE_CHECK = sig
 
     val check : Mono.file -> Mono.file
 
+    (* While we're checking, we'll do some other signature-related work, recording
+     * which environment variables are read.  This function conveys the list,
+     * coming from the most recent call to [check]. *)
+    val readEnvVars : unit -> string list
+
 end
diff --git a/src/sidecheck.sml b/src/sidecheck.sml
index b36d4935..bd11223a 100644
--- a/src/sidecheck.sml
+++ b/src/sidecheck.sml
@@ -31,29 +31,54 @@ open Mono
 
 structure E = ErrorMsg
 
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+
+val envVars = ref SS.empty
+
 fun check ds =
-    (MonoUtil.File.appLoc (fn (e, loc) =>
-                              let
-                                  fun error (k as (k1, k2)) =
-                                      if Settings.isClientOnly k then
-                                          let
-                                              val k2 = case k1 of
-                                                           "Basis" =>
-                                                           (case k2 of
-                                                                "get_client_source" => "get"
-                                                              | _ => k2)
-                                                         | _ => k2
-                                          in
-                                              E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
-                                          end
-                                      else
-                                          ()
-                              in
-                                  case e of
-                                      EFfi k => error k
-                                    | EFfiApp (k1, k2, _) => error (k1, k2)
-                                    | _ => ()
-                              end) ds;
-     ds)
+    let
+        val alreadyWarned = ref false
+    in
+        envVars := SS.empty;
+        MonoUtil.File.appLoc (fn (e, loc) =>
+                                 let
+                                     fun error (k as (k1, k2)) =
+                                         if Settings.isClientOnly k then
+                                             let
+                                                 val k2 = case k1 of
+                                                              "Basis" =>
+                                                              (case k2 of
+                                                                   "get_client_source" => "get"
+                                                                 | _ => k2)
+                                                            | _ => k2
+                                             in
+                                                 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
+                                             end
+                                         else
+                                             ()
+                                 in
+                                     case e of
+                                         EFfi k => error k
+                                       | EFfiApp ("Basis", "getenv", [(e, _)]) =>
+                                         (case #1 e of
+                                              EPrim (Prim.String (_, s)) =>
+                                              envVars := SS.add (!envVars, s)
+                                            | _ => if !alreadyWarned then
+                                                       ()
+                                                   else
+                                                       (alreadyWarned := true;
+                                                        TextIO.output (TextIO.stdErr, "WARNING: " ^ ErrorMsg.spanToString loc ^ ": reading from an environment variable not determined at compile time, which can confuse CSRF protection")))
+                                       | EFfiApp (k1, k2, _) => error (k1, k2)
+                                       | _ => ()
+                                 end) ds;
+        ds
+    end
+
+fun readEnvVars () = SS.listItems (!envVars)
 
 end
diff --git a/src/sqlite.sml b/src/sqlite.sml
index c138415b..a1095709 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -202,7 +202,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                       newline,
                       newline,
 
-                      p_list_sepi newline (fn i => fn (s, n) =>
+                      p_list_sepi newline (fn i => fn (s, _) =>
                                                       let
                                                           fun uhoh this s args =
                                                               box [p_list_sepi (box [])
diff --git a/src/urweb.grm b/src/urweb.grm
index 995d1329..7fc34793 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -216,6 +216,14 @@ fun native_op (oper, e1, e2, loc) =
         (EApp (e, e2), loc)
     end
 
+fun top_binop (oper, e1, e2, loc) =
+    let
+        val e = (EVar (["Top"], oper, Infer), loc)
+        val e = (EApp (e, e1), loc)
+    in
+        (EApp (e, e2), loc)
+    end
+
 val inDml = ref false
 
 fun tagIn bt =
@@ -395,6 +403,8 @@ fun patternOut (e : exp) =
  | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
  | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
  | CIF | CTHEN | CELSE
+ | FWDAPP | REVAPP | COMPOSE | ANDTHEN
+ | BACKTICK_PATH of string
 
 %nonterm
    file of decl list
@@ -565,6 +575,12 @@ fun patternOut (e : exp) =
 %right CAND
 %nonassoc EQ NE LT LE GT GE IS
 %right ARROW
+
+%left REVAPP
+%right FWDAPP
+%left BACKTICK_PATH
+%right COMPOSE ANDTHEN
+
 %right CARET PLUSPLUS
 %left MINUSMINUS MINUSMINUSMINUS
 %left PLUS MINUS
@@ -1202,6 +1218,22 @@ eexp   : eapps                          (case #1 eapps of
        | eexp GT eexp                   (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
        | eexp GE eexp                   (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
 
+       | eexp FWDAPP eexp               (EApp (eexp1, eexp2), s (eexp1left, eexp2right))
+       | eexp REVAPP eexp               (EApp (eexp2, eexp1), s (eexp1left, eexp2right))
+       | eexp COMPOSE eexp              (top_binop ("compose", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp ANDTHEN eexp              (top_binop ("compose", eexp2, eexp1, s (eexp1left, eexp2right)))
+       | eexp BACKTICK_PATH eexp        (let
+                                                val path = String.tokens (fn ch => ch = #".") BACKTICK_PATH
+                                                val pathModules = List.take (path, (length path -1))
+                                                val pathOp = List.last path
+
+                                                val e = (EVar (pathModules, pathOp, Infer)
+                                                        , s (BACKTICK_PATHleft, BACKTICK_PATHright))
+                                                val e = (EApp (e, eexp1), s (eexp1left, BACKTICK_PATHright))
+                                        in
+                                                (EApp (e, eexp2), s (eexp1left, eexp2right))
+                                        end)
+
        | eexp ANDALSO eexp              (let
                                              val loc = s (eexp1left, eexp2right)
                                          in
@@ -2235,6 +2267,7 @@ obopt  :                                (ECApp ((EVar (["Basis"], "sql_order_by_
                                                 (CWild (KRecord (KType, dummy), dummy), dummy)),
                                          dummy)
        | ORDER BY obexps                (obexps)
+       | ORDER BY LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
 
 obitem : sqlexp diropt                  (sqlexp, diropt)
 
diff --git a/src/urweb.lex b/src/urweb.lex
index 785f7a81..8b109727 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -182,6 +182,7 @@ cid = [A-Z][A-Za-z0-9_]*;
 ws = [\ \t\012\r];
 intconst = [0-9]+;
 realconst = [0-9]+\.[0-9]*;
+hexconst = 0x[0-9A-F]{1,8};
 notags = ([^<{\n(]|(\([^\*<{\n]))+;
 xcom = ([^\-]|(-[^\-]))+;
 oint = [0-9][0-9][0-9];
@@ -376,6 +377,15 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 <INITIAL> "&&"        => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext));
 <INITIAL> "||"        => (Tokens.ORELSE (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "<<<"       => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext));
+<INITIAL> ">>>"       => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "<|"        => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext));
+<INITIAL> "|>"        => (Tokens.REVAPP (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "`" ({cid} ".")* {id} "`"  => (Tokens.BACKTICK_PATH ( (* strip backticks *)
+                                                              substring (yytext,1,size yytext -2),
+                                                              pos yypos, pos yypos + size yytext));
+
 <INITIAL> "="         => (Tokens.EQ (pos yypos, pos yypos + size yytext));
 <INITIAL> "<>"        => (Tokens.NE (pos yypos, pos yypos + size yytext));
 <INITIAL> "<"         => (Tokens.LT (pos yypos, pos yypos + size yytext));
@@ -532,6 +542,12 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
 
+<INITIAL> {hexconst}  => (case StringCvt.scanString (Int64.scan StringCvt.HEX) (String.extract (yytext, 2, NONE)) of
+                              SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
+                            | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
+                                                           ("Expected hexInt, received: " ^ yytext);
+                                         continue ()));
+
 <INITIAL> {intconst}  => (case Int64.fromString yytext of
                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)