From 8023f94ecb26116e00e1fcd25a6bd821e998ea4a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Mon, 9 Jun 2014 18:26:03 -0400
Subject: Remove special treatment of <button>

---
 src/monoize.sml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/monoize.sml b/src/monoize.sml
index f7344fed..6572b2ac 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3650,7 +3650,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                       | "submit" => normal ("input type=\"submit\"", NONE)
                       | "image" => normal ("input type=\"image\"", NONE)
-                      | "button" => normal ("input type=\"submit\"", NONE)
                       | "hidden" => input "hidden"
 
                       | "textbox" =>
-- 
cgit v1.2.3


From d5b6e2668069721d91acb7fbcd0b2a92e08ce71e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 10 Jun 2014 10:58:22 -0400
Subject: String.trim; add OnChange to more tags

---
 lib/ur/basis.urs  |  6 +++---
 lib/ur/string.ur  | 25 +++++++++++++++++++++++++
 lib/ur/string.urs |  2 ++
 3 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index ce864563..5e5e81c3 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -946,11 +946,11 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) =>
 val hidden : formTag string [] [Data = data_attr, Id = string, Value = string]
 val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit,
                                   Ontext = transaction unit] ++ boxAttrs)
-val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs)
+val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs)
 val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit,
                                    Ontext = transaction unit] ++ boxAttrs)
 
-val checkbox : formTag bool [] ([Checked = bool] ++ boxAttrs)
+val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs)
 
 type file
 val fileName : file -> option string
@@ -1010,7 +1010,7 @@ val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Pl
                           Ontext = transaction unit] ++ boxAttrs) []
 val button : cformTag ([Value = string] ++ boxAttrs) []
 
-val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool] ++ boxAttrs) []
+val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) []
 
 con cselect = [Cselect]
 val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) cselect
diff --git a/lib/ur/string.ur b/lib/ur/string.ur
index 59a8e5c5..d760ec2b 100644
--- a/lib/ur/string.ur
+++ b/lib/ur/string.ur
@@ -86,3 +86,28 @@ fun newlines [ctx] [[Body] ~ ctx] (s : string) : xml ([Body] ++ ctx) [] [] =
 
 fun isPrefix {Full = f, Prefix = p} =
     length f >= length p && substring f {Start = 0, Len = length p} = p
+
+fun trim s =
+    let
+        val len = length s
+
+        fun findStart i =
+            if i < len && Char.isSpace (sub s i) then
+                findStart (i+1)
+            else
+                i
+
+        fun findFinish i =
+            if i >= 0 && Char.isSpace (sub s i) then
+                findFinish (i-1)
+            else
+                i
+
+        val start = findStart 0
+        val finish = findFinish (len - 1)
+    in
+        if finish >= start then
+            substring s {Start = start, Len = finish - start + 1}
+        else
+            ""
+    end
diff --git a/lib/ur/string.urs b/lib/ur/string.urs
index 0861279d..1bdca96c 100644
--- a/lib/ur/string.urs
+++ b/lib/ur/string.urs
@@ -33,3 +33,5 @@ val mp : (char -> char) -> string -> string
 val newlines : ctx ::: {Unit} -> [[Body] ~ ctx] => string -> xml ([Body] ++ ctx) [] []
 
 val isPrefix : {Full : t, Prefix : t} -> bool
+
+val trim : t -> t
-- 
cgit v1.2.3


From fb7713fd8543d1a42357d045d14909ba233151e0 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 11 Jun 2014 08:31:14 -0400
Subject: Change String to avoid Char dependency

---
 lib/ur/string.ur | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/ur/string.ur b/lib/ur/string.ur
index d760ec2b..da4e7eb4 100644
--- a/lib/ur/string.ur
+++ b/lib/ur/string.ur
@@ -92,13 +92,13 @@ fun trim s =
         val len = length s
 
         fun findStart i =
-            if i < len && Char.isSpace (sub s i) then
+            if i < len && isspace (sub s i) then
                 findStart (i+1)
             else
                 i
 
         fun findFinish i =
-            if i >= 0 && Char.isSpace (sub s i) then
+            if i >= 0 && isspace (sub s i) then
                 findFinish (i-1)
             else
                 i
-- 
cgit v1.2.3


From ac8529dadc1a0ba0621058457364b6c634ebe01c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 11 Jun 2014 13:56:00 -0400
Subject: Fix a bug in demos with 'rewrite all'

---
 src/demo.sml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/demo.sml b/src/demo.sml
index 26dcfa95..17de80ee 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -410,7 +410,7 @@ fun make' {prefix, dirname, guided} =
                 app (fn rule =>
                         (TextIO.output (outf, "rewrite ");
                          TextIO.output (outf, case #pkind rule of
-                                                  Settings.Any => "any"
+                                                  Settings.Any => "all"
                                                 | Settings.Url => "url"
                                                 | Settings.Table => "table"
                                                 | Settings.Sequence => "sequence"
-- 
cgit v1.2.3


From fa90e68cdf1bb11a89eaafca74e48e88abf7a6da Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Thu, 5 Jun 2014 20:36:12 +0000
Subject: Allow '+' char in blessMime

See this one [1] for an example

[1] - http://www.w3.org/TR/SVGTiny12/mimereg.html
---
 src/c/urweb.c    | 2 +-
 src/settings.sml | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/c/urweb.c b/src/c/urweb.c
index e337424a..020e69d4 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3604,7 +3604,7 @@ uw_Basis_string uw_Basis_checkUrl(uw_context ctx, uw_Basis_string s) {
 
 static int mime_format(const char *s) {
   for (; *s; ++s)
-    if (!isalnum((int)*s) && *s != '/' && *s != '-' && *s != '.')
+    if (!isalnum((int)*s) && *s != '/' && *s != '-' && *s != '.' && *s != '+')
       return 0;
 
   return 1;
diff --git a/src/settings.sml b/src/settings.sml
index f00a4853..ec05d84d 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -465,7 +465,7 @@ fun check f rules s =
 
 val checkUrl = check (fn _ => true) url
 
-val validMime = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #".")
+val validMime = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"." orelse ch = #"+")
 val validEnv = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #".")
 
 val checkMime = check validMime mime
-- 
cgit v1.2.3


From b81169750193dfb71fb48764619f81dbac29c37d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 11 Jun 2014 14:22:47 -0400
Subject: let..where..end

---
 doc/manual.tex    | 2 ++
 src/urweb.grm     | 1 +
 tests/letwhere.ur | 7 +++++++
 3 files changed, 10 insertions(+)
 create mode 100644 tests/letwhere.ur

diff --git a/doc/manual.tex b/doc/manual.tex
index 7fd135fa..4a11430b 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -625,6 +625,8 @@ There are infix operator syntaxes for a number of functions defined in the $\mt{
 
 A signature item $\mt{table} \; x : c$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{sql\_table} \; c \; []$.  $\mt{view} \; x : c$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{sql\_view} \; c$, $\mt{sequence} \; x$ is short for $\mt{val} \; x : \mt{Basis}.\mt{sql\_sequence}$.  $\mt{cookie} \; x : \tau$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{http\_cookie} \; \tau$, and $\mt{style} \; x$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{css\_class}$.
 
+It is possible to write a $\mt{let}$ expression with its constituents in reverse order, along the lines of Haskell's \cd{where}.  An expression $\mt{let} \; e \; \mt{where} \; ed^* \; \mt{end}$ desugars to $\mt{let} \; ed^* \; \mt{in} \; e \; \mt{end}$.
+
 
 \section{Static Semantics}
 
diff --git a/src/urweb.grm b/src/urweb.grm
index 157ecfac..4671569d 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1456,6 +1456,7 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
        | UNDER                          (EWild, s (UNDERleft, UNDERright))
 
        | LET edecls IN eexp END         (ELet (edecls, eexp), s (LETleft, ENDright))
+       | LET eexp WHERE edecls END      (ELet (edecls, eexp), s (LETleft, ENDright))
 
        | LBRACK RBRACK                  (EVar (["Basis"], "Nil", Infer), s (LBRACKleft, RBRACKright))
 
diff --git a/tests/letwhere.ur b/tests/letwhere.ur
new file mode 100644
index 00000000..8854f2aa
--- /dev/null
+++ b/tests/letwhere.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+    let
+        return <xml>Hi {[alice]} and {[bob]}!</xml>
+    where
+        val alice = "Alice"
+        val bob = "Bob"
+    end
-- 
cgit v1.2.3


From 7c2b11633dc471180b8fe7f564e0b552dd4e5c9e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 13 Jun 2014 10:57:02 -0400
Subject: Treat <button> 'value' attribute as content of tag

---
 src/monoize.sml | 26 ++++++++++++++++++++------
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/src/monoize.sml b/src/monoize.sml
index 6572b2ac..8c33e60b 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3290,6 +3290,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                     else
                         (NONE, NONE, attrs)
 
+                (* Special case for <button value=""> *)
+                val (attrs, extraString) = case tag of
+                                               "button" =>
+                                               (case List.partition (fn (x, _, _) => x = "Value") attrs of
+                                                    ([(_, value, _)], rest) =>
+                                                    (rest, SOME value)
+                                                  | _ => (attrs, 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
@@ -3464,6 +3474,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         fun normal () =
                             let
                                 val (xml, fm) = monoExp (env, st, fm) xml
+
+                                val xml = case extraString of
+                                              NONE => xml
+                                            | SOME extra => (L'.EStrcat (extra, xml), loc)
                             in
                                 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
                                               (L'.EStrcat (xml,
@@ -3483,12 +3497,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                            Substring.string bef)
                             end
                     in
-                        case xml of
-                            (L.EApp ((L.ECApp (
-                                      (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
-                                                _), _),
-                                      _), _),
-                                     (L.EPrim (Prim.String s), _)), _) =>
+                        case (xml, extraString) of
+                            ((L.EApp ((L.ECApp (
+                                       (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
+                                                 _), _),
+                                       _), _),
+                                      (L.EPrim (Prim.String s), _)), _), NONE) =>
                             if CharVector.all Char.isSpace s andalso isSingleton () then
                                 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm)
                             else
-- 
cgit v1.2.3


From 2e8e31d6edf8c75be8aa288801b910d685c67a19 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 15 Jun 2014 09:18:01 -0400
Subject: New release

---
 CHANGELOG    | 11 +++++++++++
 configure.ac |  4 ++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index 6c4d7480..c67c4899 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,14 @@
+========
+20140615
+========
+
+- New syntactic sugar: 'let E where DS end' for 'let DS in E end'
+- Add 'onChange' attributes to more tags.
+- New standard library function: String.trim
+- Start treating Ur/Web tag <button> as real HTML tag <button>,
+  with special handling of 'value' attribute as tag content.
+- Bug fixes
+
 ========
 20140531
 ========
diff --git a/configure.ac b/configure.ac
index 2446a88e..d335d72a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20140531])
-WORKING_VERSION=1
+AC_INIT([urweb], [20140615])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From c323e42161a808474fe3543823ff5f122685e2d5 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 15 Jun 2014 09:27:41 -0400
Subject: Return to working version mode

---
 configure.ac | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index d335d72a..3f940cea 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20140615])
-WORKING_VERSION=0
+WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From 9bfceb750b35c2f20d924987807702da42d12709 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 15 Jun 2014 10:48:53 -0400
Subject: 'sql_injectable_prim' instance for 'url'

---
 lib/ur/basis.urs | 1 +
 src/monoize.sml  | 4 ++++
 tests/sqlurl.ur  | 4 ++++
 tests/sqlurl.urp | 6 ++++++
 4 files changed, 15 insertions(+)
 create mode 100644 tests/sqlurl.ur
 create mode 100644 tests/sqlurl.urp

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 5e5e81c3..ce8ed91f 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -703,6 +703,7 @@ type css_value
 val atom : string -> css_value
 type url
 val css_url : url -> css_value
+val sql_url : sql_injectable_prim url
 type css_property
 val property : string -> css_property
 val value : css_property -> css_value -> css_property
diff --git a/src/monoize.sml b/src/monoize.sml
index 8c33e60b..a639f4a6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2208,6 +2208,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc),
              fm)
+          | L.EFfi ("Basis", "sql_url") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc),
+             fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) =>
             let
                 val t = monoType env t
diff --git a/tests/sqlurl.ur b/tests/sqlurl.ur
new file mode 100644
index 00000000..cdd51ca8
--- /dev/null
+++ b/tests/sqlurl.ur
@@ -0,0 +1,4 @@
+table t : { Url : url }
+
+task initialize = fn () =>
+     dml (INSERT INTO t (Url) VALUES ({[bless "http://www.google.com/"]}))
diff --git a/tests/sqlurl.urp b/tests/sqlurl.urp
new file mode 100644
index 00000000..bb5544df
--- /dev/null
+++ b/tests/sqlurl.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql sqlurl.sql
+rewrite url Sqlurl/*
+allow url http://www.google.com/
+
+sqlurl
-- 
cgit v1.2.3


From 0a45f32c63f2d9a3df8c8ea15ea67b8e8c0fef5a Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Sun, 15 Jun 2014 21:13:12 +0000
Subject: Call try_rollback before resetting the context

This will allow FFI cleanup handlers to complete.
---
 src/c/request.c | 16 ++++++++--------
 src/c/urweb.c   |  2 +-
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/c/request.c b/src/c/request.c
index 5aee7bbe..f212655f 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -503,14 +503,14 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
           had_error = 1;
           strcpy(errmsg, uw_error_message(ctx));
         } else {
+          try_rollback(ctx, 0, logger_data, log_error);
+
           uw_write_header(ctx, "Content-type: text/html\r\n");
           uw_write(ctx, "<html><head><title>Fatal Error</title></head><body>");
           uw_write(ctx, "Fatal error: ");
           uw_write(ctx, uw_error_message(ctx));
           uw_write(ctx, "\n</body></html>");
         
-          try_rollback(ctx, 0, logger_data, log_error);
-
           return FAILED;
         }
       } else
@@ -527,14 +527,14 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
           had_error = 1;
           strcpy(errmsg, uw_error_message(ctx));
         } else {
+          try_rollback(ctx, 0, logger_data, log_error);
+
           uw_reset_keep_error_message(ctx);
           on_failure(ctx);
           uw_write_header(ctx, "Content-type: text/plain\r\n");
           uw_write(ctx, "Fatal error (out of retries): ");
           uw_write(ctx, uw_error_message(ctx));
           uw_write(ctx, "\n");
-          
-          try_rollback(ctx, 0, logger_data, log_error);
 
           return FAILED;
         }
@@ -548,6 +548,8 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
         had_error = 1;
         strcpy(errmsg, uw_error_message(ctx));
       } else {
+        try_rollback(ctx, 0, logger_data, log_error);
+
         uw_reset_keep_error_message(ctx);
         on_failure(ctx);
         uw_write_header(ctx, "Content-type: text/html\r\n");
@@ -556,8 +558,6 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
         uw_write(ctx, uw_error_message(ctx));
         uw_write(ctx, "\n</body></html>");
 
-        try_rollback(ctx, 0, logger_data, log_error);
-
         return FAILED;
       }
     } else {
@@ -567,13 +567,13 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
         had_error = 1;
         strcpy(errmsg, "Unknown uw_handle return code");
       } else {
+        try_rollback(ctx, 0, logger_data, log_error);
+
         uw_reset_keep_request(ctx);
         on_failure(ctx);
         uw_write_header(ctx, "Content-type: text/plain\r\n");
         uw_write(ctx, "Unknown uw_handle return code!\n");
 
-        try_rollback(ctx, 0, logger_data, log_error);
-
         return FAILED;
       }
     }
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 020e69d4..7b95d6a9 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3343,7 +3343,7 @@ int uw_commit(uw_context ctx) {
           if (ctx->transactionals[i].free)
             ctx->transactionals[i].free(ctx->transactionals[i].data, 1);
 
-	return 1;
+        return 1;
       }
 
       for (i = ctx->used_transactionals-1; i >= 0; --i)
-- 
cgit v1.2.3


From 4d2154f281d63408567a4f063dc4a5f9846cbf44 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 25 Jun 2014 14:04:13 -0400
Subject: New syntactic shorthand for antiquoting subqueries

---
 doc/manual.tex |  2 +-
 src/urweb.grm  |  8 ++++++++
 tests/tags.ur  | 23 +++++++++++++++++++++++
 tests/tags.urp |  6 ++++++
 4 files changed, 38 insertions(+), 1 deletion(-)
 create mode 100644 tests/tags.ur
 create mode 100644 tests/tags.urp

diff --git a/doc/manual.tex b/doc/manual.tex
index 4a11430b..97e5d2c0 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2280,7 +2280,7 @@ $$\begin{array}{rrcll}
   &&& \{\{e\}\} \; \mt{AS} \; \{c\} & \textrm{computed table expression, with computed local name} \\
   \textrm{$\mt{FROM}$ items} & F &::=& T \mid \{\{e\}\} \mid F \; J \; \mt{JOIN} \; F \; \mt{ON} \; E \\
   &&& \mid F \; \mt{CROSS} \; \mt{JOIN} \ F \\
-  &&& \mid (Q) \; \mt{AS} \; t \\
+  &&& \mid (Q) \; \mt{AS} \; t \mid (\{\{e\}\}) \; \mt{AS} \; t \\
   \textrm{Joins} & J &::=& [\mt{INNER}] \\
   &&& \mid [\mt{LEFT} \mid \mt{RIGHT} \mid \mt{FULL}] \; [\mt{OUTER}] \\
   \textrm{SQL expressions} & E &::=& t.f & \textrm{column references} \\
diff --git a/src/urweb.grm b/src/urweb.grm
index 4671569d..1f4540ba 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1981,6 +1981,14 @@ fitem  : table'                         ([#1 table'], #2 table')
                                          in
                                              ([tname], (EApp (e, query), loc))
                                          end)
+       | LPAREN LBRACE LBRACE eexp RBRACE RBRACE RPAREN AS tname   (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             ([tname], (EApp (e, eexp), loc))
+                                         end)
        | LPAREN fitem RPAREN            (fitem)
 
 tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
diff --git a/tests/tags.ur b/tests/tags.ur
new file mode 100644
index 00000000..1213d824
--- /dev/null
+++ b/tests/tags.ur
@@ -0,0 +1,23 @@
+table images : { Id : int, Content : blob }
+table tags : { Id : int, Tag : string }
+
+datatype mode = Present | Absent
+type condition = { Tag : string, Mode : mode }
+
+type tag_query = sql_query [] [] [] [Id = int]
+
+fun addCondition (c : condition) (q : tag_query) : tag_query =
+    case c.Mode of
+        Present => (SELECT I.Id AS Id
+                    FROM ({{q}}) AS I
+                      JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
+      | Absent => q
+
+fun withConditions (cs : list condition) : tag_query =
+    List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
+
+fun main (cs : list condition) : transaction page =
+    x <- queryX (withConditions cs) (fn r => <xml><li>{[r.Id]}</li></xml>);
+    return <xml><body>
+      {x}
+    </body></xml>
diff --git a/tests/tags.urp b/tests/tags.urp
new file mode 100644
index 00000000..b2f21c5a
--- /dev/null
+++ b/tests/tags.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql tags.sql
+rewrite url Tags/*
+
+$/list
+tags
-- 
cgit v1.2.3


From 2000d8de5719e6a3aa94dd3f52c9dc3c1170c9fa Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 25 Jun 2014 14:19:58 -0400
Subject: Finish example

---
 tests/tags.ur | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/tests/tags.ur b/tests/tags.ur
index 1213d824..059e869a 100644
--- a/tests/tags.ur
+++ b/tests/tags.ur
@@ -11,7 +11,10 @@ fun addCondition (c : condition) (q : tag_query) : tag_query =
         Present => (SELECT I.Id AS Id
                     FROM ({{q}}) AS I
                       JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
-      | Absent => q
+      | Absent => (SELECT I.Id AS Id
+                   FROM ({{q}}) AS I
+                     LEFT JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]}
+                   WHERE tags.Tag IS NULL)
 
 fun withConditions (cs : list condition) : tag_query =
     List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
-- 
cgit v1.2.3


From 362a3c350554cc0deee1f05a4e005c1d63bcd526 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 27 Jun 2014 14:39:31 -0400
Subject: Add locking to enforce atomicity of message sends from one
 transaction

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

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 7b95d6a9..86cd2b8b 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3304,6 +3304,8 @@ static char *find_sig(char *haystack) {
   return s;
 }
 
+static pthread_mutex_t message_send_mutex = PTHREAD_MUTEX_INITIALIZER;
+
 int uw_commit(uw_context ctx) {
   int i;
   char *sig;
@@ -3323,10 +3325,17 @@ int uw_commit(uw_context ctx) {
         }
       }
 
+  // Here's an important lock to provide the abstraction that all messages from one transaction are sent as an atomic unit.
+  if (ctx->used_deltas > 0)
+    pthread_mutex_lock(&message_send_mutex);
+
   if (ctx->transaction_started) {
     int code = ctx->app->db_commit(ctx);
 
     if (code) {
+      if (ctx->used_deltas > 0)
+        pthread_mutex_unlock(&message_send_mutex);
+
       if (ctx->client)
         release_client(ctx->client);
 
@@ -3360,16 +3369,19 @@ int uw_commit(uw_context ctx) {
       if (ctx->transactionals[i].commit) {
         ctx->transactionals[i].commit(ctx->transactionals[i].data);
         if (uw_has_error(ctx)) {
-           if (ctx->client)
-             release_client(ctx->client);
+          if (ctx->used_deltas > 0)
+            pthread_mutex_unlock(&message_send_mutex);
 
-           for (i = ctx->used_transactionals-1; i >= 0; --i)
-             if (ctx->transactionals[i].rollback != NULL)
-               ctx->transactionals[i].rollback(ctx->transactionals[i].data);
+          if (ctx->client)
+            release_client(ctx->client);
 
-           for (i = ctx->used_transactionals-1; i >= 0; --i)
-             if (ctx->transactionals[i].free)
-               ctx->transactionals[i].free(ctx->transactionals[i].data, 0);
+          for (i = ctx->used_transactionals-1; i >= 0; --i)
+            if (ctx->transactionals[i].rollback != NULL)
+              ctx->transactionals[i].rollback(ctx->transactionals[i].data);
+
+          for (i = ctx->used_transactionals-1; i >= 0; --i)
+            if (ctx->transactionals[i].free)
+              ctx->transactionals[i].free(ctx->transactionals[i].data, 0);
 
           return 0;
         }
@@ -3385,6 +3397,9 @@ int uw_commit(uw_context ctx) {
     client_send(c, &d->msgs, ctx->script.start, uw_buffer_used(&ctx->script));
   }
 
+  if (ctx->used_deltas > 0)
+    pthread_mutex_unlock(&message_send_mutex);
+
   if (ctx->client)
     release_client(ctx->client);
 
-- 
cgit v1.2.3


From abb214d29dd8088b5dad7b61aefb7db24fa787ac Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 29 Jun 2014 08:31:21 -0400
Subject: Fix uw_Basis_lt_time

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

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 86cd2b8b..a9e722ad 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4271,7 +4271,7 @@ uw_Basis_bool uw_Basis_eq_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t
 }
 
 uw_Basis_bool uw_Basis_lt_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) {
-  return !!(t1.seconds < t2.seconds || t1.microseconds < t2.microseconds);
+  return !!(t1.seconds < t2.seconds || (t1.seconds == t2.seconds && t1.microseconds < t2.microseconds));
 }
 
 uw_Basis_bool uw_Basis_le_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) {
-- 
cgit v1.2.3


From 26fde08de43211e6b4e8e6c1f02173629232b0ac Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 29 Jun 2014 08:33:47 -0400
Subject: Top.max and Top.min

---
 lib/ur/top.ur  | 5 +++++
 lib/ur/top.urs | 3 +++
 2 files changed, 8 insertions(+)

diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 5b9d43ab..3250a5a3 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -405,3 +405,8 @@ fun postFields pb =
             "application/x-www-form-urlencoded" => postFields' (postData pb)
           | _ => error <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
     end
+
+fun max [t] ( _ : ord t) (x : t) (y : t) : t =
+    if x > y then x else y
+fun min [t] ( _ : ord t) (x : t) (y : t) : t =
+    if x < y then x else y
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 2ea86dc4..15bc6a22 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -287,3 +287,6 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
 val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
 
 val postFields : postBody -> list (string * string)
+
+val max : t ::: Type -> ord t -> t -> t -> t
+val min : t ::: Type -> ord t -> t -> t -> t
-- 
cgit v1.2.3


From fd80cc09e2015def28904009cb79e70ddb678850 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 4 Jul 2014 09:30:30 -0400
Subject: New release

---
 CHANGELOG    | 9 +++++++++
 configure.ac | 4 ++--
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index c67c4899..e8bf5071 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,12 @@
+========
+20140704
+========
+
+- New syntactic shorthand for antiquoting subqueries
+- New Top members: max and min
+- 'sql_injectable_prim' instance for 'url'
+- Bug fixes
+
 ========
 20140615
 ========
diff --git a/configure.ac b/configure.ac
index 3f940cea..8776a563 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20140615])
-WORKING_VERSION=1
+AC_INIT([urweb], [20140704])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From ee2eb6ac79b2a23a998e8feb4043bbf593e9bc5c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 4 Jul 2014 09:41:32 -0400
Subject: Return to working version mode

---
 configure.ac | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 8776a563..8132bac4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20140704])
-WORKING_VERSION=0
+WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From 0e31dda702cffe9c52a45b0443da549bc8ad00e6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 13 Jul 2014 06:14:23 -0400
Subject: Fix off-by-one error in less-safe FFI wrapper generation

---
 src/corify.sml       | 11 ++++++++---
 tests/lessSafeFfi.ur |  5 +++--
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/src/corify.sml b/src/corify.sml
index b08ef7eb..162ae1ab 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -1203,8 +1203,13 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
                     L'.TFun (dom, ran) => (L'.TFun (dom, addLastBit ran), #2 t)
                   | _ => (L'.TFun ((L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), t), loc)
 
-            val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' - 1, t', [])), loc)
-            val (e, tTrans) = if isTransactional t' then
+            val isTrans = isTransactional t'
+            val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' -
+                                               (if isTrans then
+                                                    0
+                                                else
+                                                    1), t', [])), loc)
+            val (e, tTrans) = if isTrans then
                                   ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t')
                               else
                                   (e, t')
@@ -1216,7 +1221,7 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
                   | Source.ServerOnly => Settings.addServerOnly name
                   | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
 
-            if isTransactional t' andalso not (Settings.isBenignEffectful name) then
+            if isTrans andalso not (Settings.isBenignEffectful name) then
                 Settings.addEffectful name
             else
                 ();
diff --git a/tests/lessSafeFfi.ur b/tests/lessSafeFfi.ur
index da79bfdc..ec96db0a 100644
--- a/tests/lessSafeFfi.ur
+++ b/tests/lessSafeFfi.ur
@@ -1,15 +1,16 @@
 ffi foo : int -> int
 ffi bar serverOnly benignEffectful : int -> transaction unit
 ffi baz : transaction int
+ffi adder : int -> int -> int
 
-ffi bup jsFunc "jsbup" : int -> transaction unit
+ffi bup jsFunc "alert" : string -> transaction unit
 
 fun other () : transaction page =
     (*bar 17;
     q <- baz;*)
     return <xml><body>
       (*{[foo 42]}, {[q]}*)
-      <button onclick={fn _ => bup 32}/>
+      <button onclick={fn _ => bup "asdf"}/>
     </body></xml>
 
 fun main () = return <xml><body>
-- 
cgit v1.2.3


From 63acfc44762cbbf3d8d957127a3c5eed3a399940 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 16 Jul 2014 04:06:11 -0400
Subject: Default 'jsFunc' for less-safe FFI

---
 doc/manual.tex       | 2 ++
 src/corify.sml       | 5 +++++
 tests/lessSafeFfi.ur | 4 +++-
 3 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/doc/manual.tex b/doc/manual.tex
index 97e5d2c0..65f6f95d 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2552,6 +2552,8 @@ Now \texttt{foo} is available as a normal function.  If called in server-side co
 \item \texttt{jsFunc "putJsFuncNameHere"}
 \end{itemize}
 
+When no \texttt{jsFunc} directive is present, the function is assumed to map to a JavaScript function of the same name, if used in a client-side context.
+
 
 \section{Compiler Phases}
 
diff --git a/src/corify.sml b/src/corify.sml
index 162ae1ab..5d58efcc 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -1221,6 +1221,11 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
                   | Source.ServerOnly => Settings.addServerOnly name
                   | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
 
+            if List.exists (fn Source.JsFunc _ => true | _ => false) modes then
+                ()
+            else
+                Settings.addJsFunc (name, #2 name);
+
             if isTrans andalso not (Settings.isBenignEffectful name) then
                 Settings.addEffectful name
             else
diff --git a/tests/lessSafeFfi.ur b/tests/lessSafeFfi.ur
index ec96db0a..6bf26ba9 100644
--- a/tests/lessSafeFfi.ur
+++ b/tests/lessSafeFfi.ur
@@ -4,13 +4,15 @@ ffi baz : transaction int
 ffi adder : int -> int -> int
 
 ffi bup jsFunc "alert" : string -> transaction unit
+ffi alert : string -> transaction unit
 
 fun other () : transaction page =
     (*bar 17;
     q <- baz;*)
     return <xml><body>
       (*{[foo 42]}, {[q]}*)
-      <button onclick={fn _ => bup "asdf"}/>
+      <button value="bup" onclick={fn _ => bup "asdf"}/>
+      <button value="alert" onclick={fn _ => alert "qqqz"}/>
     </body></xml>
 
 fun main () = return <xml><body>
-- 
cgit v1.2.3


From d02a82a0a573b381543365aeb7e44da32980a452 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Mon, 21 Jul 2014 08:11:03 -0400
Subject: Fix index-matching bug in MonoReduce effect calculation

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

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index c92ce5aa..3b4f0fd8 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, 2013, Adam Chlipala
+(* Copyright (c) 2008, 2013-2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -471,7 +471,7 @@ fun reduce (file : file) =
 
                       | ECase (e, pes, _) =>
                         let
-                            val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes
+                            val lss = map (fn (p, e) => summarize (if d = ~1 then ~1 else d + patBinds p) e) pes
 
                             fun splitRel ls acc =
                                 case ls of
@@ -510,7 +510,7 @@ fun reduce (file : file) =
                         List.concat [summarize d query,
                                      summarize d initial,
                                      [ReadDb],
-                                     summarize (d + 2) body]
+                                     summarize (if d = ~1 then ~1 else d + 2) body]
 
                       | EDml (e, _) => summarize d e @ [WriteDb]
                       | ENextval e => summarize d e @ [WriteDb]
@@ -585,7 +585,7 @@ fun reduce (file : file) =
                                 val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
                                 val effs_b = summarize 0 b
 
-                                (*val () = Print.fprefaces outf "Try"
+                                (*val () = Print.prefaces "Try"
                                                         [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
                                                          ("e'", MonoPrint.p_exp env e'),
                                                          ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
-- 
cgit v1.2.3


From 3d296b7992440c7bc14dff01e5de82e6f364cc09 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 26 Jul 2014 09:26:11 -0400
Subject: Another MonoReduce fix

---
 src/mono_reduce.sml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 3b4f0fd8..98e81185 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -502,7 +502,7 @@ fun reduce (file : file) =
                       | EWrite e => summarize d e @ [WritePage]
                                     
                       | ESeq (e1, e2) => summarize d e1 @ summarize d e2
-                      | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2
+                      | ELet (_, _, e1, e2) => summarize d e1 @ summarize (if d = ~1 then ~1 else d + 1) e2
 
                       | EClosure (_, es) => List.concat (map (summarize d) es)
 
-- 
cgit v1.2.3


From 11e4fd74efb535f8681b5be83c914bb2ca1bcc7f Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 26 Jul 2014 09:39:45 -0400
Subject: Manual: Heuristic compilation warning

---
 doc/manual.tex | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/doc/manual.tex b/doc/manual.tex
index 65f6f95d..2218d2c5 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -377,6 +377,10 @@ Compiled applications consult a few environment variables to modify their behavi
   \item \cd{URWEB\_PQ\_CON}: when using PostgreSQL, overrides the compiled-in connection string
 \end{itemize}
 
+\subsection{A Word of Warning on Heuristic Compilation}
+
+For server-side code, Ur/Web follows an unusual compilation model, where not all type-correct programs can be compiled successfully, especially when using functions as data not known until runtime.  See Section \ref{phases} for more detail.
+
 
 \section{Ur Syntax}
 
@@ -2555,9 +2559,9 @@ Now \texttt{foo} is available as a normal function.  If called in server-side co
 When no \texttt{jsFunc} directive is present, the function is assumed to map to a JavaScript function of the same name, if used in a client-side context.
 
 
-\section{Compiler Phases}
+\section{\label{phases}Compiler Phases}
 
-The Ur/Web compiler is unconventional in that it relies on a kind of \emph{heuristic compilation}.  Not all valid programs will compile successfully.  Informally, programs fail to compile when they are ``too higher order.''  Compiler phases do their best to eliminate different kinds of higher order-ness, but some programs just won't compile.  This is a trade-off for producing very efficient executables.  Compiled Ur/Web programs use native C representations and require no garbage collection.
+The Ur/Web compiler is unconventional in that it relies on a kind of \emph{heuristic compilation}.  Not all valid programs will compile successfully.  Informally, programs fail to compile when they are ``too higher order.''  Compiler phases do their best to eliminate different kinds of higher order-ness, but some programs just won't compile.  This is a trade-off for producing very efficient executables.  Compiled Ur/Web programs use native C representations and require no garbage collection.  Also, this warning only applies to server-side code, as client-side code runs in a normal JavaScript environment with garbage collection.
 
 In this section, we step through the main phases of compilation, noting what consequences each phase has for effective programming.
 
-- 
cgit v1.2.3


From 2d7238252d0cd1165f74aea511a03b9899ca105b Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 29 Jul 2014 14:38:50 -0400
Subject: Small tweak to ordering of unification rules, to support better
 record matching

---
 src/elaborate.sml      | 10 +++++-----
 tests/empty_record.ur  |  3 +++
 tests/empty_record.urp |  2 ++
 3 files changed, 10 insertions(+), 5 deletions(-)
 create mode 100644 tests/empty_record.ur
 create mode 100644 tests/empty_record.urp

diff --git a/src/elaborate.sml b/src/elaborate.sml
index d492883f..5029ef4d 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1220,6 +1220,11 @@
              else
                  err (fn _ => TooLifty (loc1, loc2))
 
+           | (L'.CRecord _, _) => isRecord ()
+           | (_, L'.CRecord _) => isRecord ()
+           | (L'.CConcat _, _) => isRecord ()
+           | (_, L'.CConcat _) => isRecord ()
+
            | (L'.CUnif (0, _, _, _, r as ref (L'.Unknown f)), _) =>
              if occursCon r c2All then
                  err COccursCheckFailed
@@ -1262,11 +1267,6 @@
                   end
                   handle CantSquish => err (fn _ => TooDeep))
 
-           | (L'.CRecord _, _) => isRecord ()
-           | (_, L'.CRecord _) => isRecord ()
-           | (L'.CConcat _, _) => isRecord ()
-           | (_, L'.CConcat _) => isRecord ()
-
 
            | (L'.CUnit, L'.CUnit) => ()
 
diff --git a/tests/empty_record.ur b/tests/empty_record.ur
new file mode 100644
index 00000000..45ab6fdb
--- /dev/null
+++ b/tests/empty_record.ur
@@ -0,0 +1,3 @@
+val concatX [ctx ::: {Unit}] [use ::: {Type}]
+    : list (xml ctx use []) -> xml ctx use []
+  = List.foldl join <xml/>
diff --git a/tests/empty_record.urp b/tests/empty_record.urp
new file mode 100644
index 00000000..c81175fc
--- /dev/null
+++ b/tests/empty_record.urp
@@ -0,0 +1,2 @@
+$/list
+empty_record
-- 
cgit v1.2.3


From c771a68c26e952531aca922c0837d961991bd3bc Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 29 Jul 2014 14:46:06 -0400
Subject: Retweak the last tweak to allow type inference to succeed in a strict
 superset of the places where it used to succeed

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

diff --git a/src/elaborate.sml b/src/elaborate.sml
index 5029ef4d..03e9d6e8 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2013, Adam Chlipala
+(* Copyright (c) 2008-2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -1191,6 +1191,12 @@
                  (L'.CProj (c1, n1), _) => projSpecial1 (c1, n1, isRecord')
                | (_, L'.CProj (c2, n2)) => projSpecial2 (c2, n2, isRecord')
                | _ => isRecord' ()
+
+         fun maybeIsRecord c =
+             case c of
+                 L'.CRecord _ => isRecord ()
+               | L'.CConcat _ => isRecord ()
+               | _ => err COccursCheckFailed
      in
          (*eprefaces "unifyCons''" [("c1", p_con env c1All),
                                   ("c2", p_con env c2All)];*)
@@ -1220,21 +1226,16 @@
              else
                  err (fn _ => TooLifty (loc1, loc2))
 
-           | (L'.CRecord _, _) => isRecord ()
-           | (_, L'.CRecord _) => isRecord ()
-           | (L'.CConcat _, _) => isRecord ()
-           | (_, L'.CConcat _) => isRecord ()
-
            | (L'.CUnif (0, _, _, _, r as ref (L'.Unknown f)), _) =>
              if occursCon r c2All then
-                 err COccursCheckFailed
+                 maybeIsRecord c2
              else if f c2All then
                  r := L'.Known c2All
              else
                  err CScope
            | (_, L'.CUnif (0, _, _, _, r as ref (L'.Unknown f))) =>
              if occursCon r c1All then
-                 err COccursCheckFailed
+                 maybeIsRecord c1
              else if f c1All then
                  r := L'.Known c1All
              else
@@ -1242,7 +1243,7 @@
 
            | (L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f)), _) =>
              if occursCon r c2All then
-                 err COccursCheckFailed
+                 maybeIsRecord c2
              else
                  (let
                       val sq = squish nl c2All
@@ -1255,7 +1256,7 @@
                   handle CantSquish => err (fn _ => TooDeep))
            | (_, L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f))) =>
              if occursCon r c1All then
-                 err COccursCheckFailed
+                 maybeIsRecord c1
              else
                  (let
                       val sq = squish nl c1All
@@ -1267,6 +1268,11 @@
                   end
                   handle CantSquish => err (fn _ => TooDeep))
 
+           | (L'.CRecord _, _) => isRecord ()
+           | (_, L'.CRecord _) => isRecord ()
+           | (L'.CConcat _, _) => isRecord ()
+           | (_, L'.CConcat _) => isRecord ()
+
 
            | (L'.CUnit, L'.CUnit) => ()
 
-- 
cgit v1.2.3


From 08bbe52588b9d195295f1b5aca14c88a9ae3ea3c Mon Sep 17 00:00:00 2001
From: Samuel Dukhovni <dukhovni@mit.edu>
Date: Mon, 28 Jul 2014 20:18:43 -0400
Subject: Added javascript for Basis.strsindex

---
 lib/js/urweb.js  | 7 +++++++
 src/settings.sml | 1 +
 2 files changed, 8 insertions(+)

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index c3cab50a..76a900f7 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1212,6 +1212,13 @@ function sidx(s, ch) {
     else
         return r;
 }
+function ssidx(h, n) {
+    var r = h.indexOf(n);
+    if (r == -1)
+        return null;
+    else
+        return r;
+}
 function sspn(s, chs) {
     for (var i = 0; i < s.length; ++i)
         if (chs.indexOf(s.charAt(i)) != -1)
diff --git a/src/settings.sml b/src/settings.sml
index ec05d84d..ff3ab83a 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -289,6 +289,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("strsuffix", "suf"),
                           ("strlen", "slen"),
                           ("strindex", "sidx"),
+                          ("strsindex", "ssidx"),
                           ("strchr", "schr"),
                           ("substring", "ssub"),
                           ("strcspn", "sspn"),
-- 
cgit v1.2.3


From 3154131cddb8bc8fe76b86bd9f4902f1d531bce6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 31 Jul 2014 09:56:41 -0400
Subject: New .urp directive: file

---
 doc/manual.tex            |   3 +-
 include/urweb/urweb_cpp.h |   1 +
 src/c/urweb.c             |   5 +++
 src/cjr_print.sml         |  48 ++++++++++++++++++++--
 src/compiler.sml          |   9 ++++
 src/settings.sig          |   6 +++
 src/settings.sml          | 102 ++++++++++++++++++++++++++++++++++++++++++++++
 tests/files.ur            |   1 +
 tests/files.urp           |   6 +++
 tests/hello.txt           |   1 +
 tests/web.png             | Bin 0 -> 9565 bytes
 11 files changed, 178 insertions(+), 4 deletions(-)
 create mode 100644 tests/files.ur
 create mode 100644 tests/files.urp
 create mode 100644 tests/hello.txt
 create mode 100644 tests/web.png

diff --git a/doc/manual.tex b/doc/manual.tex
index 2218d2c5..32ed9fc2 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -146,7 +146,8 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
 \item \texttt{database DBSTRING} sets the string to pass to libpq to open a database connection.
 \item \texttt{debug} saves some intermediate C files, which is mostly useful to help in debugging the compiler itself.
 \item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  This is the default behavior for \texttt{transaction}-based types.
-\item \texttt{exe FILENAME} sets the filename to which to write the output executable.  The default for file \texttt{P.urp} is \texttt{P.exe}.  
+\item \texttt{exe FILENAME} sets the filename to which to write the output executable.  The default for file \texttt{P.urp} is \texttt{P.exe}.
+\item \texttt{file URI FILENAME} asks for the application executable to respond to requests for \texttt{URI} by serving a snapshot of the contents of \texttt{FILENAME} as of compile time.  That is, the file contents are baked into the executable.  System file \texttt{/etc/mime.types} is consulted (again, at compile time) to figure out the right MIME type to suggest in the HTTP response.
 \item \texttt{ffi FILENAME} reads the file \texttt{FILENAME.urs} to determine the interface to a new FFI module.  The name of the module is calculated from \texttt{FILENAME} in the same way as for normal source files.  See the files \texttt{include/urweb/urweb\_cpp.h} and \texttt{src/c/urweb.c} for examples of C headers and implementations for FFI modules.  In general, every type or value \texttt{Module.ident} becomes \texttt{uw\_Module\_ident} in C.
 \item \texttt{html5} activates work-in-progress support for generating HTML5 instead of XHTML.  For now, this option only affects the first few tokens on any page, which are always the same.
 \item \texttt{include FILENAME} adds \texttt{FILENAME} to the list of files to be \texttt{\#include}d in C sources.  This is most useful for interfacing with new FFI modules.
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 5a4411e8..72997a12 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -263,6 +263,7 @@ void uw_mayReturnIndirectly(struct uw_context *);
 __attribute__((noreturn)) void uw_return_blob(struct uw_context *, uw_Basis_blob, uw_Basis_string mimeType);
 __attribute__((noreturn)) void uw_return_blob_from_page(struct uw_context *, uw_Basis_string mimeType);
 __attribute__((noreturn)) void uw_redirect(struct uw_context *, uw_Basis_string url);
+void uw_replace_page(struct uw_context *, const char *data, size_t size);
 
 uw_Basis_time uw_Basis_now(struct uw_context *);
 uw_Basis_time uw_Basis_addSeconds(struct uw_context *, uw_Basis_time, uw_Basis_int);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index a9e722ad..1799d01e 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3861,6 +3861,11 @@ __attribute__((noreturn)) void uw_return_blob(uw_context ctx, uw_Basis_blob b, u
   longjmp(ctx->jmp_buf, RETURN_INDIRECTLY);
 }
 
+void uw_replace_page(uw_context ctx, const char *data, size_t size) {
+  uw_buffer_reset(&ctx->page);
+  ctx_uw_buffer_append(ctx, "page", &ctx->page, data, size);
+}
+
 __attribute__((noreturn)) void uw_return_blob_from_page(uw_context ctx, uw_Basis_string mimeType) {
   cleanup *cl;
   int len;
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 05dce35e..9046acc8 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, Adam Chlipala
+(* Copyright (c) 2008-2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -3293,6 +3293,17 @@ fun p_file env (ds, ps) =
         val now = Time.now ()
         val nowD = Date.fromTimeUniv now
         val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
+
+        fun hexifyByte (b : Word8.word) : string =
+            let
+                val s = Int.fmt StringCvt.HEX (Word8.toInt b)
+            in
+                "\\x" ^ (if size s < 2 then "0" else "") ^ s
+            end
+
+        fun hexify (v : Word8Vector.vector) : string =
+            String.concat (Word8Vector.foldr (fn (b, ls) =>
+                                                 hexifyByte b :: ls) [] v)
     in
         box [string "#include \"",
              string (OS.Path.joinDirFile {dir = !Settings.configInclude,
@@ -3476,9 +3487,9 @@ fun p_file env (ds, ps) =
                   string "}",
                   newline,
                   newline,
-                  string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");",
+                  string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
                   newline,
-                  string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
+                  string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
                   newline,
                   string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),                  
                   newline,
@@ -3487,6 +3498,37 @@ fun p_file env (ds, ps) =
                   string "return;",
                   newline],
              string "}",
+             newline,
+             newline,
+
+             p_list_sep newline (fn r =>
+                                    box [string "if (!strcmp(request, \"",
+                                         string (String.toCString (#Uri r)),
+                                         string "\")) {",
+                                         newline,
+                                         box [(case #ContentType r of
+                                                   NONE => box []
+                                                 | SOME ct => box [string "uw_write_header(ctx, \"Content-Type: ",
+                                                                   string (String.toCString ct),
+                                                                   string "\\r\\n\");",
+                                                                   newline]),
+                                              string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"),
+                                              newline,
+                                              string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
+                                              newline,
+                                              string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),                  
+                                              newline,
+                                              string "uw_replace_page(ctx, \"",
+                                              string (hexify (#Bytes r)),
+                                              string "\", ",
+                                              string (Int.toString (Word8Vector.length (#Bytes r))),
+                                              string ");",
+                                              newline,
+                                              string "return;",
+                                              newline],
+                                         string "};",
+                                         newline]) (Settings.listFiles ()),
+
              newline,
              p_list_sep newline (fn x => x) pds',
              newline,
diff --git a/src/compiler.sml b/src/compiler.sml
index 269a7824..2190684a 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -461,6 +461,8 @@ fun parseUrp' accLibs fname =
          end
      else
          let
+             val thisPath = OS.Path.dir fname
+
              val pathmap = ref (!pathmap)
              val bigLibs = ref []
 
@@ -876,6 +878,13 @@ fun parseUrp' accLibs fname =
                                    | "html5" => Settings.setIsHtml5 true
                                    | "lessSafeFfi" => Settings.setLessSafeFfi true
 
+                                   | "file" =>
+                                     (case String.fields Char.isSpace arg of
+                                          [uri, fname] => (Settings.setFilePath thisPath;
+                                                           Settings.addFile {Uri = uri,
+                                                                             LoadFromFilename = fname})
+                                        | _ => ErrorMsg.error "Bad 'file' arguments")
+
                                    | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
                                  read ()
                              end
diff --git a/src/settings.sig b/src/settings.sig
index 29c4c506..9b32e502 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -278,4 +278,10 @@ signature SETTINGS = sig
 
     val setLessSafeFfi : bool -> unit
     val getLessSafeFfi : unit -> bool
+
+    val setFilePath : string -> unit
+    (* Sets the directory where we look for files being added below. *)
+
+    val addFile : {Uri : string, LoadFromFilename : string} -> unit
+    val listFiles : unit -> {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector} list
 end
diff --git a/src/settings.sml b/src/settings.sml
index ff3ab83a..eb350c95 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -744,4 +744,106 @@ val less = ref false
 fun setLessSafeFfi b = less := b
 fun getLessSafeFfi () = !less
 
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val noMimeFile = ref false
+
+fun noMime () =
+    (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types.  Static files will be served with no suggested MIME types.\n");
+     noMimeFile := true;
+     SM.empty)
+
+fun readMimeTypes () =
+    let
+        val inf = TextIO.openIn "/etc/mime.types"
+
+        fun loop m =
+            case TextIO.inputLine inf of
+                NONE => m
+              | SOME line =>
+                if size line > 0 andalso String.sub (line, 0) = #"#" then
+                    loop m
+                else
+                    case String.tokens Char.isSpace line of
+                        typ :: exts =>
+                        loop (foldl (fn (ext, m) => SM.insert (m, ext, typ)) m exts)
+                      | _ => loop m
+    in
+        loop SM.empty
+        before TextIO.closeIn inf
+    end handle IO.Io _ => noMime ()
+             | OS.SysErr _ => noMime ()
+
+val mimeTypes = ref (NONE : string SM.map option)
+
+fun getMimeTypes () =
+    case !mimeTypes of
+        SOME m => m
+      | NONE =>
+        let
+            val m = readMimeTypes ()
+        in
+            mimeTypes := SOME m;
+            m
+        end
+
+fun mimeTypeOf filename =
+    case OS.Path.ext filename of
+        NONE => (if !noMimeFile then
+                     ()
+                 else
+                     TextIO.output (TextIO.stdErr, "WARNING: No extension found in filename '" ^ filename ^ "'.  Header 'Content-Type' will be omitted in HTTP responses.\n");
+                 NONE)
+      | SOME ext =>
+        let
+            val to = SM.find (getMimeTypes (), ext)
+        in
+            case to of
+                NONE => if !noMimeFile then
+                            ()
+                        else
+                            TextIO.output (TextIO.stdErr, "WARNING: No MIME type known for extension '" ^ ext ^ "'.  Header 'Content-Type' will be omitted in HTTP responses.\n")
+              | _ => ();
+            to
+        end
+
+val files = ref (SM.empty : (string * {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector}) SM.map)
+
+val filePath = ref "."
+
+fun setFilePath path = filePath := path
+
+fun addFile {Uri, LoadFromFilename} =
+    let
+        val path = OS.Path.joinDirFile {dir = !filePath, file = LoadFromFilename}
+    in
+        case SM.find (!files, Uri) of
+            SOME (path', _) =>
+            if path' = path then
+                ()
+            else
+                ErrorMsg.error ("Two different files requested for URI " ^ Uri)
+          | NONE =>
+            let
+                val inf = BinIO.openIn path
+            in
+                files := SM.insert (!files,
+                                    Uri,
+                                    (path,
+                                     {Uri = Uri,
+                                      ContentType = mimeTypeOf path,
+                                      LastModified = OS.FileSys.modTime path,
+                                      Bytes = BinIO.inputAll inf}));
+                BinIO.closeIn inf
+            end
+    end handle IO.Io _ =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename)
+             | OS.SysErr (s, _) =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename ^ " (" ^ s ^ ")")
+
+fun listFiles () = map #2 (SM.listItems (!files))
+
 end
diff --git a/tests/files.ur b/tests/files.ur
new file mode 100644
index 00000000..94cf8eb1
--- /dev/null
+++ b/tests/files.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml>Main page</xml>
diff --git a/tests/files.urp b/tests/files.urp
new file mode 100644
index 00000000..100992e5
--- /dev/null
+++ b/tests/files.urp
@@ -0,0 +1,6 @@
+rewrite all Files/*
+file /hello_world.txt hello.txt
+file /img/web.png web.png
+file /files.urp files.urp
+
+files
diff --git a/tests/hello.txt b/tests/hello.txt
new file mode 100644
index 00000000..980a0d5f
--- /dev/null
+++ b/tests/hello.txt
@@ -0,0 +1 @@
+Hello World!
diff --git a/tests/web.png b/tests/web.png
new file mode 100644
index 00000000..17548060
Binary files /dev/null and b/tests/web.png differ
-- 
cgit v1.2.3


From 8ef3bce7ec88bb0c73a5885bca9f27526a1eae8b Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 1 Aug 2014 11:43:44 -0400
Subject: 'aria-*' attributes

---
 doc/manual.tex     |  2 +-
 lib/ur/basis.urs   |  8 ++++++--
 src/monoize.sml    |  9 +++++++--
 src/urweb.grm      | 11 +++++++----
 tests/data_attr.ur |  6 +++---
 5 files changed, 24 insertions(+), 12 deletions(-)

diff --git a/doc/manual.tex b/doc/manual.tex
index 32ed9fc2..0550d081 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2065,7 +2065,7 @@ $$\begin{array}{l}
 
 We will not list here the different HTML tags and related functions from the standard library.  They should be easy enough to understand from the code in \texttt{basis.urs}.  The set of tags in the library is not yet claimed to be complete for HTML standards.  Also note that there is currently no way for the programmer to add his own tags, without using the foreign function interface (Section \ref{ffi}).
 
-Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind.  See \texttt{basis.urs} for details.  The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar.
+Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind.  See \texttt{basis.urs} for details.  The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar, and the same mechanism is reused to support \texttt{aria-*} attributes.
 
 One last useful function is for aborting any page generation, returning some XML as an error message.  This function takes the place of some uses of a general exception mechanism.
 $$\begin{array}{l}
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index ce8ed91f..8efed25b 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -797,9 +797,13 @@ val active : unit
 val script : unit
              -> tag [Code = transaction unit] head [] [] []
 
-(* Type for HTML5 "data-*" attributes. *)
+(* Type for HTML5 "data-*" and "aria-*" attributes. *)
+type data_attr_kind
+val data_kind : data_attr_kind
+val aria_kind : data_attr_kind
+
 type data_attr
-val data_attr : string (* Key *) -> string (* Value *) -> data_attr
+val data_attr : data_attr_kind -> string (* Key *) -> string (* Value *) -> data_attr
 (* This function will fail if the key doesn't meet HTML's lexical rules! *)
 val data_attrs : data_attr -> data_attr -> data_attr
 
diff --git a/src/monoize.sml b/src/monoize.sml
index a639f4a6..9182c077 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -235,6 +235,7 @@ fun monoType env =
                   | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) =>
@@ -3122,12 +3123,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
-          | L.EFfiApp ("Basis", "data_attr", [(s1, _), (s2, _)]) =>
+          | L.EFfi ("Basis", "data_kind") => ((L'.EPrim (Prim.String "data-"), loc), fm)
+          | L.EFfi ("Basis", "aria_kind") => ((L'.EPrim (Prim.String "aria-"), loc), fm)
+
+          | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) =>
             let
+                val (sk, fm) = monoExp (env, st, fm) sk
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat ((L'.EPrim (Prim.String "data-"), loc),
+                ((L'.EStrcat (sk,
                               (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc),
                                            (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc),
                                                         (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc),
diff --git a/src/urweb.grm b/src/urweb.grm
index 1f4540ba..862debc5 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -225,7 +225,7 @@ fun tagIn bt =
 
 datatype prop_kind = Delete | Update
 
-datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * exp
+datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * string * exp
 
 fun patType loc (p : pat) =
     case #1 p of
@@ -486,7 +486,7 @@ fun patternOut (e : exp) =
  | rpat of (string * pat) list * bool
  | ptuple of pat list
 
- | attrs of exp option * exp option * exp option * exp option * (string * exp) list * (con * exp) list
+ | attrs of exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list
  | attr of attr
  | attrv of exp
 
@@ -1652,9 +1652,10 @@ tag    : tagHead attrs                  (let
                                                             [] => #6 attrs
                                                           | data :: datas =>
                                                             let
-                                                                fun doOne (name, value) =
+                                                                fun doOne (kind, name, value) =
                                                                     let
                                                                         val e = (EVar (["Basis"], "data_attr", Infer), pos)
+                                                                        val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos)
                                                                         val e = (EApp (e, (EPrim (Prim.String name), pos)), pos)
                                                                     in
                                                                         (EApp (e, value), pos)
@@ -1725,7 +1726,9 @@ attr   : SYMBOL EQ attrv                (case SYMBOL of
 					   | "dynStyle" => DynStyle attrv
 					   | _ =>
                                              if String.isPrefix "data-" SYMBOL then
-                                                 Data (String.extract (SYMBOL, 5, NONE), attrv)
+                                                 Data ("data", String.extract (SYMBOL, 5, NONE), attrv)
+                                             else if String.isPrefix "aria-" SYMBOL then
+                                                 Data ("aria", String.extract (SYMBOL, 5, NONE), attrv)
                                              else
                                                  let
                                                      val sym = makeAttr SYMBOL
diff --git a/tests/data_attr.ur b/tests/data_attr.ur
index 80dda857..4462dc10 100644
--- a/tests/data_attr.ur
+++ b/tests/data_attr.ur
@@ -1,5 +1,5 @@
 fun dynd r = return <xml><body>
-  <div data={data_attr r.Attr r.Value}>How about that?</div>
+  <div data={data_attr data_kind r.Attr r.Value}>How about that?</div>
 </body></xml>
 
 fun main () : transaction page =
@@ -7,7 +7,7 @@ fun main () : transaction page =
   a <- source "";
   v <- source "";
   return <xml><body>
-    <div data-foo="hi" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
+    <div data-foo="hi" aria-something="wow" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
 
     <hr/>
 
@@ -20,7 +20,7 @@ fun main () : transaction page =
 
     <ctextbox source={a}/> = <ctextbox source={v}/>
     <button onclick={fn _ =>
-      a <- get a; v <- get v; set s <xml><div data={data_attr a v}>OHO!</div></xml>}/>
+      a <- get a; v <- get v; set s <xml><div data={data_attr data_kind a v}>OHO!</div></xml>}/>
     <hr/>
     <dyn signal={signal s}/>
   </body></xml>
-- 
cgit v1.2.3


From b6d4f55981faff6ca7fa8b890c22ff4f33302ef2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 1 Aug 2014 15:44:17 -0400
Subject: Differentiate between HTML and normal string literals

---
 src/cjr_print.sml   |  16 +-
 src/cjrize.sml      |  10 +-
 src/iflow.sml       |  18 +-
 src/jscomp.sml      |  18 +-
 src/mono_opt.sml    | 186 +++++++-------
 src/mono_reduce.sml |  10 +-
 src/monoize.sml     | 707 +++++++++++++++++++++++++---------------------------
 src/pathcheck.sml   |   2 +-
 src/prepare.sml     |  16 +-
 src/prim.sig        |   6 +-
 src/prim.sml        |  16 +-
 src/shake.sml       |   2 +-
 src/sql.sml         |   8 +-
 src/urweb.grm       |  36 +--
 14 files changed, 516 insertions(+), 535 deletions(-)

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 9046acc8..a4cc8c54 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -203,10 +203,10 @@ fun p_patMatch (env, disc) (p, loc) =
                                    Prim.p_t_GCC (Prim.Int n),
                                    string ")"]
       | PPrim (Prim.String s) => box [string ("!strcmp(" ^ disc),
-                                      string ",",
-                                      space,
-                                      Prim.p_t_GCC (Prim.String s),
-                                      string ")"]
+                                           string ",",
+                                           space,
+                                           Prim.p_t_GCC (Prim.String s),
+                                           string ")"]
       | PPrim (Prim.Char ch) => box [string ("(" ^ disc),
                                      space,
                                      string "==",
@@ -503,16 +503,16 @@ fun getPargs (e, _) =
 
       | ECase (e,
                [((PNone _, _),
-                 (EPrim (Prim.String "NULL"), _)),
+                 (EPrim (Prim.String (_, "NULL")), _)),
                 ((PSome (_, (PVar _, _)), _),
                  (EFfiApp (m, x, [((ERel 0, _), _)]), _))],
                {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e))
 
       | ECase (e,
                [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
-                 (EPrim (Prim.String "TRUE"), _)),
+                 (EPrim (Prim.String (_, "TRUE")), _)),
                 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
-                 (EPrim (Prim.String "FALSE"), _))],
+                 (EPrim (Prim.String (_, "FALSE")), _))],
                _) => [(e, Bool)]
 
       | _ => raise Fail "CjrPrint: getPargs"
@@ -2218,7 +2218,7 @@ and p_exp' par tail env (e, loc) =
                  NONE => #nextval (Settings.currentDbms ()) {loc = loc,
                                                              seqE = p_exp' false false env seq,
                                                              seqName = case #1 seq of
-                                                                           EPrim (Prim.String s) => SOME s
+                                                                           EPrim (Prim.String (_, s)) => SOME s
                                                                          | _ => NONE}
                | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
                                                                                  id = id,
diff --git a/src/cjrize.sml b/src/cjrize.sml
index d153feff..6dc0299c 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -242,7 +242,7 @@ fun cifyExp (eAll as (e, loc), sm) =
     let
         fun fail msg =
             (ErrorMsg.errorAt loc msg;
-             ((L'.EPrim (Prim.String ""), loc), sm))
+             ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), sm))
     in
         case e of
             L.EPrim p => ((L'.EPrim p, loc), sm)
@@ -632,7 +632,7 @@ fun cifyDecl ((d, loc), sm) =
             fun flatten e =
                 case #1 e of
                     L.ERecord [] => []
-                  | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)]
+                  | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)]
                   | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
                   | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
                           Print.prefaces "Undetermined constraint"
@@ -640,7 +640,7 @@ fun cifyDecl ((d, loc), sm) =
                           [])
 
             val pe = case #1 pe of
-                         L.EPrim (Prim.String s) => s
+                         L.EPrim (Prim.String (_, s)) => s
                        | _ => (ErrorMsg.errorAt loc "Primary key has not been fully determined";
                                Print.prefaces "Undetermined constraint"
                                               [("e", MonoPrint.p_exp MonoEnv.empty pe)];
@@ -662,7 +662,7 @@ fun cifyDecl ((d, loc), sm) =
             fun flatten e =
                 case #1 e of
                     L.ERecord [] => []
-                  | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)]
+                  | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)]
                   | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
                   | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
                           Print.prefaces "Undetermined constraint"
@@ -670,7 +670,7 @@ fun cifyDecl ((d, loc), sm) =
                           [])
 
             val e = case #1 e of
-                        L.EPrim (Prim.String s) => s
+                        L.EPrim (Prim.String (_, s)) => s
                       | _ => (ErrorMsg.errorAt loc "VIEW query has not been fully determined";
                               Print.prefaces "Undetermined VIEW query"
                                              [("e", MonoPrint.p_exp MonoEnv.empty e)];
diff --git a/src/iflow.sml b/src/iflow.sml
index 461dc956..40cf8993 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -1446,7 +1446,7 @@ fun evalExp env (e as (_, loc)) k =
                                  case es of
                                      [_, (cname, _), _, _, _] =>
                                      (case #1 cname of
-                                          EPrim (Prim.String cname) =>
+                                          EPrim (Prim.String (_, cname)) =>
                                           St.havocCookie cname
                                         | _ => ())
                                    | _ => ()
@@ -1637,7 +1637,7 @@ fun evalExp env (e as (_, loc)) k =
                                                                                        | Update (tab, _, _) =>
                                                                                          (cs, SS.add (ts, tab)))
                                                                               | EFfiApp ("Basis", "set_cookie",
-                                                                                         [_, ((EPrim (Prim.String cname), _), _),
+                                                                                         [_, ((EPrim (Prim.String (_, cname)), _), _),
                                                                                           _, _, _]) =>
                                                                                 (SS.add (cs, cname), ts)
                                                                               | _ => st}
@@ -1765,7 +1765,7 @@ fun evalExp env (e as (_, loc)) k =
                                     handle Cc.Contradiction => ())
                      end)
                      
-          | ENextval (EPrim (Prim.String seq), _) =>
+          | ENextval (EPrim (Prim.String (_, seq)), _) =>
             let
                 val nv = St.nextVar ()
             in
@@ -1775,7 +1775,7 @@ fun evalExp env (e as (_, loc)) k =
           | ENextval _ => default ()
           | ESetval _ => default ()
 
-          | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String cname), _), _)]), _), _, _) =>
+          | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String (_, cname)), _), _)]), _), _, _) =>
             let
                 val e = Var (St.nextVar ())
                 val e' = Func (Other ("cookie/" ^ cname), [])
@@ -1843,9 +1843,9 @@ fun nameSubexps k (e : Mono.exp) =
                                 (e', fn e' => (EFfiApp (m, f, [(e', t)]), #2 e))
                           | ECase (e', ps as
                                           [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
-                                            (EPrim (Prim.String "TRUE"), _)),
+                                            (EPrim (Prim.String (_, "TRUE")), _)),
                                            ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
-                                            (EPrim (Prim.String "FALSE"), _))], q) =>
+                                            (EPrim (Prim.String (_, "FALSE")), _))], q) =>
                             (e', fn e' => (ECase (e', ps, q), #2 e))
                           | _ => (e, fn x => x)
                 in
@@ -1907,7 +1907,7 @@ fun check (file : file) =
                 let
                     val ks =
                         case #1 pk of
-                            EPrim (Prim.String s) =>
+                            EPrim (Prim.String (_, s)) =>
                             (case String.tokens (fn ch => ch = #"," orelse ch = #" ") s of
                                  [] => []
                                | pk => [pk])
@@ -1974,7 +1974,7 @@ fun check (file : file) =
                           | EFfi _ => e
                           | EFfiApp (m, f, es) =>
                             (case (m, f, es) of
-                                 ("Basis", "set_cookie", [_, ((EPrim (Prim.String cname), _), _), _, _, _]) =>
+                                 ("Basis", "set_cookie", [_, ((EPrim (Prim.String (_, cname)), _), _), _, _, _]) =>
                                  cookies := SS.add (!cookies, cname)
                                | _ => ();
                              (EFfiApp (m, f, map (fn (e, t) => (doExp env e, t)) es), loc))
@@ -2150,7 +2150,7 @@ fun check (file : file) =
                               | _ => raise Fail "Iflow: No New or Old in mayUpdate policy") e
                       | PolSequence e =>
                         (case #1 e of
-                             EPrim (Prim.String seq) =>
+                             EPrim (Prim.String (_, seq)) =>
                              let
                                  val p = AReln (Sql (String.extract (seq, 3, NONE)), [Lvar 0])
                                  val outs = [Lvar 0]
diff --git a/src/jscomp.sml b/src/jscomp.sml
index bcabed0b..1a476739 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -55,7 +55,7 @@ type state = {
 
 fun strcat loc es =
     case es of
-        [] => (EPrim (Prim.String ""), loc)
+        [] => (EPrim (Prim.String (Prim.Normal, "")), loc)
       | [x] => x
       | x :: es' => (EStrcat (x, strcat loc es'), loc)
 
@@ -81,7 +81,7 @@ fun process (file : file) =
                     | (_, state) => state)
                   (IM.empty, IM.empty) (#1 file)
 
-        fun str loc s = (EPrim (Prim.String s), loc)
+        fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc)
 
         fun isNullable (t, _) =
             case t of
@@ -149,7 +149,7 @@ fun process (file : file) =
                     val (e', st) = quoteExp loc t ((ERel 0, loc), st)
                 in
                     (case #1 e' of
-                        EPrim (Prim.String "ERROR") => raise Fail "UHOH"
+                        EPrim (Prim.String (_, "ERROR")) => raise Fail "UHOH"
                       | _ =>
                         (ECase (e,
                                 [((PNone t, loc),
@@ -450,7 +450,7 @@ fun process (file : file) =
                                                             3)
                             in
                                 case p of
-                                    Prim.String s =>
+                                    Prim.String (_, s) =>
                                     str ("\"" ^ String.translate jsChar s ^ "\"")
                                   | Prim.Char ch => str ("\"" ^ jsChar ch ^ "\"")
                                   | _ => str (Prim.toString p)
@@ -519,7 +519,7 @@ fun process (file : file) =
 
                         fun deStrcat level (all as (e, loc)) =
                             case e of
-                                EPrim (Prim.String s) => jsifyStringMulti (level, s)
+                                EPrim (Prim.String (_, s)) => jsifyStringMulti (level, s)
                               | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
                               | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\""
                               | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code";
@@ -1021,10 +1021,10 @@ fun process (file : file) =
              case #1 e of
                  EPrim p =>
                  (case p of
-                      Prim.String s => if inString {needle = "<script", haystack = s} then
-                                           foundJavaScript := true
-                                       else
-                                           ()
+                      Prim.String (_, s) => if inString {needle = "<script", haystack = s} then
+                                                foundJavaScript := true
+                                            else
+                                                ()
                     | _ => ();
                   (e, st))
                | ERel _ => (e, st)
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index ae306e68..d1e5ce55 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -145,7 +145,7 @@ fun checkProperty s = size s > 0
 
 fun exp e =
     case e of
-        EPrim (Prim.String s) =>
+        EPrim (Prim.String (Prim.Html, s)) =>
         if CharVector.exists Char.isSpace s then
             let
                 val (_, chs) =
@@ -160,14 +160,14 @@ fun exp e =
                                          end)
                                      (false, []) s
             in
-                EPrim (Prim.String (String.implode (rev chs)))
+                EPrim (Prim.String (Prim.Html, String.implode (rev chs)))
             end
         else
             e
 
       | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2))
-                                       
-      | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) =>
+           
+      | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) =>
         let
             val s =
                 if size s1 > 0 andalso size s2 > 0
@@ -177,10 +177,13 @@ fun exp e =
                 else
                     s1 ^ s2
         in
-            EPrim (Prim.String s)
+            EPrim (Prim.String (Prim.Html, s))
         end
+                            
+      | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) =>
+        EPrim (Prim.String (Prim.Normal, s1 ^ s2))
 
-      | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) =>
+      | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) =>
         let
             val s =
                 if size s1 > 0 andalso size s2 > 0
@@ -190,9 +193,12 @@ fun exp e =
                 else
                     s1 ^ s2
         in
-            EStrcat ((EPrim (Prim.String s), loc), rest)
+            EStrcat ((EPrim (Prim.String (Prim.Html, s)), loc), rest)
         end
 
+      | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EStrcat ((EPrim (Prim.String (_, s2)), _), rest), _)) =>
+        EStrcat ((EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), rest)
+
       | EStrcat ((EStrcat (e1, e2), loc), e3) =>
         optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
 
@@ -200,27 +206,27 @@ fun exp e =
         ESeq ((optExp (EWrite e1, loc), loc),
               (optExp (EWrite e2, loc), loc))
 
-      | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
-              (EWrite (EPrim (Prim.String s2), _), _)) =>
-        EWrite (EPrim (Prim.String (s1 ^ s2)), loc)
-      | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
-              (ESeq ((EWrite (EPrim (Prim.String s2), _), _),
+      | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc),
+              (EWrite (EPrim (Prim.String (_, s2)), _), _)) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc)
+      | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc),
+              (ESeq ((EWrite (EPrim (Prim.String (_, s2)), _), _),
                      e), _)) =>
-        ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc),
+        ESeq ((EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), loc),
               e)
 
       | EFfiApp ("Basis", "htmlifySpecialChar", [((EPrim (Prim.Char ch), _), _)]) =>
-        EPrim (Prim.String (htmlifySpecialChar ch))
+        EPrim (Prim.String (Prim.Html, htmlifySpecialChar ch))
       | EWrite (EFfiApp ("Basis", "htmlifySpecialChar", [e]), _) =>
         EFfiApp ("Basis", "htmlifySpecialChar_w", [e])
 
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", [((EPrim (Prim.Int n), _), _)]), _), _)]) =>
-        EPrim (Prim.String (htmlifyInt n))
+        EPrim (Prim.String (Prim.Html, htmlifyInt n))
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", es), _), _)]) =>
         EFfiApp ("Basis", "htmlifyInt", es)
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _),
                                                     (EPrim (Prim.Int n), _)), _), _)]) =>
-        EPrim (Prim.String (htmlifyInt n))
+        EPrim (Prim.String (Prim.Html, htmlifyInt n))
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _),
                                                     e), loc), _)]) =>
         EFfiApp ("Basis", "htmlifyInt", [(e, (TFfi ("Basis", "int"), loc))])
@@ -228,12 +234,12 @@ fun exp e =
         EFfiApp ("Basis", "htmlifyInt_w", [e])
 
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", [((EPrim (Prim.Float n), _), _)]), _), _)]) =>
-        EPrim (Prim.String (htmlifyFloat n))
+        EPrim (Prim.String (Prim.Html, htmlifyFloat n))
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", es), _), _)]) =>
         EFfiApp ("Basis", "htmlifyFloat", es)
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _),
                                                     (EPrim (Prim.Float n), _)), _), _)]) =>
-        EPrim (Prim.String (htmlifyFloat n))
+        EPrim (Prim.String (Prim.Html, htmlifyFloat n))
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _),
                                                     e), loc), _)]) =>
         EFfiApp ("Basis", "htmlifyFloat", [(e, (TFfi ("Basis", "float"), loc))])
@@ -242,18 +248,18 @@ fun exp e =
 
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString",
                                                        [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), _), _)]) =>
-        EPrim (Prim.String "True")
+        EPrim (Prim.String (Prim.Html, "True"))
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString",
                                                        [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), _), _)]) =>
-        EPrim (Prim.String "False")
+        EPrim (Prim.String (Prim.Html, "False"))
       | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", es), _), _)]) =>
         EFfiApp ("Basis", "htmlifyBool", es)
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
                                                     (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _), _)]) =>
-        EPrim (Prim.String "True")
+        EPrim (Prim.String (Prim.Html, "True"))
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
                                                     (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _), _)]) =>
-        EPrim (Prim.String "False")
+        EPrim (Prim.String (Prim.Html, "False"))
       | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
                                                     e), loc), _)]) =>
         EFfiApp ("Basis", "htmlifyBool", [(e, (TFfi ("Basis", "bool"), loc))])
@@ -267,106 +273,106 @@ fun exp e =
       | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) =>
         EFfiApp ("Basis", "htmlifyTime_w", [e])
 
-      | EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String s), _), _)]) =>
-        EPrim (Prim.String (htmlifyString s))
-      | EWrite (EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String s), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (htmlifyString s)), loc)
+      | EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyString s))
+      | EWrite (EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc)
       | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) =>
         EFfiApp ("Basis", "htmlifyString_w", [e])
-      | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String s), loc), _)]) =>
-        EWrite (EPrim (Prim.String (htmlifyString s)), loc)
+      | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String (_, s)), loc), _)]) =>
+        EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc)
 
       | EWrite (EFfiApp ("Basis", "htmlifySource", [e]), _) =>
         EFfiApp ("Basis", "htmlifySource_w", [e])
 
       | EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]) =>
-        EPrim (Prim.String (attrifyInt n))
+        EPrim (Prim.String (Prim.Html, attrifyInt n))
       | EWrite (EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (attrifyInt n)), loc)
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyInt n)), loc)
       | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) =>
         EFfiApp ("Basis", "attrifyInt_w", [e])
 
       | EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
-        EPrim (Prim.String (attrifyFloat n))
+        EPrim (Prim.String (Prim.Html, attrifyFloat n))
       | EWrite (EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (attrifyFloat n)), loc)
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyFloat n)), loc)
       | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) =>
         EFfiApp ("Basis", "attrifyFloat_w", [e])
 
-      | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]) =>
-        EPrim (Prim.String (attrifyString s))
-      | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (attrifyString s)), loc)
+      | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, attrifyString s))
+      | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyString s)), loc)
       | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
         EFfiApp ("Basis", "attrifyString_w", [e])
 
       | EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]) =>
-        EPrim (Prim.String (attrifyChar s))
+        EPrim (Prim.String (Prim.Html, attrifyChar s))
       | EWrite (EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (attrifyChar s)), loc)
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyChar s)), loc)
       | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) =>
         EFfiApp ("Basis", "attrifyChar_w", [e])
 
-      | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]) =>
-        EPrim (Prim.String s)
-      | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String s), loc)
+      | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, s))
+      | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, s)), loc)
       | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) =>
         EFfiApp ("Basis", "attrifyString_w", [e])
 
       | EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]) =>
-        EPrim (Prim.String (urlifyInt n))
+        EPrim (Prim.String (Prim.Normal, urlifyInt n))
       | EWrite (EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (urlifyInt n)), loc)
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyInt n)), loc)
       | EWrite (EFfiApp ("Basis", "urlifyInt", [e]), _) =>
         EFfiApp ("Basis", "urlifyInt_w", [e])
 
       | EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
-        EPrim (Prim.String (urlifyFloat n))
+        EPrim (Prim.String (Prim.Normal, urlifyFloat n))
       | EWrite (EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (urlifyFloat n)), loc)
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyFloat n)), loc)
       | EWrite (EFfiApp ("Basis", "urlifyFloat", [e]), _) =>
         EFfiApp ("Basis", "urlifyFloat_w", [e])
 
-      | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]) =>
-        EPrim (Prim.String (urlifyString s))
-      | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String (urlifyString s)), loc)
+      | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, urlifyString s))
+      | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (Prim.Normal, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyString s)), loc)
       | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) =>
         EFfiApp ("Basis", "urlifyString_w", [e])
 
       | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) =>
-        EPrim (Prim.String "1")
+        EPrim (Prim.String (Prim.Normal, "1"))
       | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) =>
-        EPrim (Prim.String "0")
+        EPrim (Prim.String (Prim.Normal, "0"))
       | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String "1"), loc)
+        EWrite (EPrim (Prim.String (Prim.Normal, "1")), loc)
       | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), loc) =>
-        EWrite (EPrim (Prim.String "0"), loc)
+        EWrite (EPrim (Prim.String (Prim.Normal, "0")), loc)
       | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) =>
         EFfiApp ("Basis", "urlifyBool_w", [e])
 
       | EFfiApp ("Basis", "sqlifyInt", [((EPrim (Prim.Int n), _), _)]) =>
-        EPrim (Prim.String (sqlifyInt n))
+        EPrim (Prim.String (Prim.Normal, sqlifyInt n))
       | EFfiApp ("Basis", "sqlifyIntN", [((ENone _, _), _)]) =>
-        EPrim (Prim.String "NULL")
+        EPrim (Prim.String (Prim.Normal, "NULL"))
       | EFfiApp ("Basis", "sqlifyIntN", [((ESome (_, (EPrim (Prim.Int n), _)), _), _)]) =>
-        EPrim (Prim.String (sqlifyInt n))
+        EPrim (Prim.String (Prim.Normal, sqlifyInt n))
 
       | EFfiApp ("Basis", "sqlifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
-        EPrim (Prim.String (sqlifyFloat n))
+        EPrim (Prim.String (Prim.Normal, sqlifyFloat n))
       | EFfiApp ("Basis", "sqlifyBool", [(b as (_, loc), _)]) =>
         optExp (ECase (b,
                        [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc),
-                         (EPrim (Prim.String (#trueString (Settings.currentDbms ()))), loc)),
+                         (EPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))), loc)),
                         ((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc),
-                         (EPrim (Prim.String (#falseString (Settings.currentDbms ()))), loc))],
+                         (EPrim (Prim.String (Prim.Normal, #falseString (Settings.currentDbms ()))), loc))],
                        {disc = (TFfi ("Basis", "bool"), loc),
                         result = (TFfi ("Basis", "string"), loc)}), loc)
-      | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String n), _), _)]) =>
-        EPrim (Prim.String (sqlifyString n))
+      | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String (_, n)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyString n))
       | EFfiApp ("Basis", "sqlifyChar", [((EPrim (Prim.Char n), _), _)]) =>
-        EPrim (Prim.String (sqlifyChar n))
+        EPrim (Prim.String (Prim.Normal, sqlifyChar n))
 
       | EWrite (ECase (discE, pes, {disc, ...}), loc) =>
         optExp (ECase (discE,
@@ -388,11 +394,11 @@ fun exp e =
         end
 
       | EWrite (EQuery {exps, tables, state, query,
-                        initial = (EPrim (Prim.String ""), _),
-                        body = (EStrcat ((EPrim (Prim.String s), _),
+                        initial = (EPrim (Prim.String (k, "")), _),
+                        body = (EStrcat ((EPrim (Prim.String (_, s)), _),
                                          (EStrcat ((ERel 0, _),
                                                    e'), _)), _)}, loc) =>
-        if CharVector.all Char.isSpace s then
+        if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then
             EQuery {exps = exps, tables = tables, query = query,
                     state = (TRecord [], loc),
                     initial = (ERecord [], loc),
@@ -401,7 +407,7 @@ fun exp e =
             e
 
       | EWrite (EQuery {exps, tables, state, query,
-                        initial = (EPrim (Prim.String ""), _),
+                        initial = (EPrim (Prim.String (_, "")), _),
                         body}, loc) =>
         let
             fun passLets (depth, (e', _), lets) =
@@ -439,94 +445,94 @@ fun exp e =
       | EWrite (ELet (x, t, e1, e2), loc) =>
         optExp (ELet (x, t, e1, (EWrite e2, loc)), loc)
 
-      | EWrite (EPrim (Prim.String ""), loc) =>
+      | EWrite (EPrim (Prim.String (_, "")), loc) =>
         ERecord []
 
       | ESignalBind ((ESignalReturn e1, loc), e2) =>
         optExp (EApp (e2, e1), loc)
 
-      | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkData s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid HTML5 data-* attribute " ^ s);
          se)
 
-      | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkUrl s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'bless'");
          se)
-      | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkUrl s then
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
-      | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkMime s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMime'");
          se)
-      | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkMime s then
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
-      | EFfiApp ("Basis", "atom", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "atom", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkAtom s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'atom'");
          se)
-      | EFfiApp ("Basis", "css_url", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "css_url", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkCssUrl s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'css_url'");
          se)
-      | EFfiApp ("Basis", "property", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "property", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if checkProperty s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'property'");
          se)
-      | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkRequestHeader s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessRequestHeader'");
          se)
-      | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkRequestHeader s then
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
-      | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkResponseHeader s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessResponseHeader'");
          se)
-      | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkResponseHeader s then
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
-      | EFfiApp ("Basis", "blessEnvVar", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "blessEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkEnvVar s then
              ()
          else
              ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessEnvVar'");
          se)
-      | EFfiApp ("Basis", "checkEnvVar", [((se as EPrim (Prim.String s), loc), _)]) =>
+      | EFfiApp ("Basis", "checkEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
         (if Settings.checkEnvVar s then
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
 
-      | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String s), loc), _)]) => 
+      | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) => 
         let
             fun uwify (cs, acc) =
                 case cs of
@@ -551,10 +557,10 @@ fun exp e =
                         #"_" :: cs => uwify (cs, ["uw_"])
                       | cs => uwify (cs, [])
         in
-            EPrim (Prim.String s)
+            EPrim (Prim.String (Prim.Normal, s))
         end
 
-      | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String s), loc), _)]) => 
+      | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) => 
         let
             fun uwify (cs, acc) =
                 case cs of
@@ -576,11 +582,11 @@ fun exp e =
 
             val s = uwify (String.explode s, [])
         in
-            EPrim (Prim.String s)
+            EPrim (Prim.String (Prim.Normal, s))
         end
 
-      | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String s), _), _)]) => 
-        EPrim (Prim.String (unAs s))
+      | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) => 
+        EPrim (Prim.String (Prim.Normal, unAs s))
       | EFfiApp ("Basis", "unAs", [(e', _)]) =>
         let
             fun parts (e as (_, loc)) =
@@ -589,7 +595,7 @@ fun exp e =
                     (case (parts s1, parts s2) of
                          (SOME p1, SOME p2) => SOME (p1 @ p2)
                        | _ => NONE)
-                  | EPrim (Prim.String s) => SOME [(EPrim (Prim.String (unAs s)), loc)]
+                  | EPrim (Prim.String (_, s)) => SOME [(EPrim (Prim.String (Prim.Normal, unAs s)), loc)]
                   | EFfiApp ("Basis", f, [_]) =>
                     if String.isPrefix "sqlify" f then
                         SOME [e]
@@ -607,7 +613,7 @@ fun exp e =
         end
 
       | EFfiApp ("Basis", "str1", [((EPrim (Prim.Char ch), _), _)]) =>
-        EPrim (Prim.String (str ch))
+        EPrim (Prim.String (Prim.Normal, str ch))
       | EFfiApp ("Basis", "attrifyString", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
         EFfiApp ("Basis", "attrifyChar", [e])
       | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 98e81185..f1a6758d 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -190,13 +190,13 @@ fun match (env, p : pat, e : exp) =
         (PWild, _) => Yes env
       | (PVar (x, t), _) => Yes ((x, t, e) :: env)
 
-      | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) =>
+      | (PPrim (Prim.String (_, s)), EStrcat ((EPrim (Prim.String (_, s')), _), _)) =>
         if String.isPrefix s' s then
             Maybe
         else
             No
 
-      | (PPrim (Prim.String s), EStrcat (_, (EPrim (Prim.String s'), _))) =>
+      | (PPrim (Prim.String (_, s)), EStrcat (_, (EPrim (Prim.String (_, s')), _))) =>
         if String.isSuffix s' s then
             Maybe
         else
@@ -756,8 +756,10 @@ fun reduce (file : file) =
 
                       | ELet (x, t, e', b) => doLet (x, t, e', b)
 
-                      | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) =>
-                        EPrim (Prim.String (s1 ^ s2))
+                      | EStrcat ((EPrim (Prim.String (k1, s1)), _), (EPrim (Prim.String (k2, s2)), _)) =>
+                        EPrim (Prim.String ((case (k1, k2) of
+                                                 (Prim.Html, Prim.Html) => Prim.Html
+                                               | _ => Prim.Normal), s1 ^ s2))
 
                       | ESignalBind ((ESignalReturn e1, loc), e2) =>
                         #1 (reduceExp env (EApp (e2, e1), loc))
diff --git a/src/monoize.sml b/src/monoize.sml
index 9182c077..a1f97184 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -515,7 +515,7 @@ fun fooifyExp fk env =
                 let
                     val (_, _, _, s) = Env.lookupENamed env fnam
                 in
-                    ((L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm)
+                    ((L'.EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm)
                 end
               | L'.EClosure (fnam, args) =>
                 let
@@ -531,21 +531,21 @@ fun fooifyExp fk env =
                             in
                                 attrify (args, ft,
                                          (L'.EStrcat (e,
-                                                      (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc),
+                                                      (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "/")), loc),
                                                                    arg'), loc)), loc),
                                          fm)
                             end
                           | _ => (E.errorAt loc "Type mismatch encoding attribute";
                                   (e, fm))
                 in
-                    attrify (args, ft, (L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm)
+                    attrify (args, ft, (L'.EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm)
                 end
               | _ =>
                 case t of
-                    L'.TFfi ("Basis", "unit") => ((L'.EPrim (Prim.String ""), loc), fm)
+                    L'.TFfi ("Basis", "unit") => ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), fm)
                   | L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm)
 
-                  | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm)
+                  | L'.TRecord [] => ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), fm)
                   | L'.TRecord ((x, t) :: xts) =>
                     let
                         val (se, fm) = fooify fm ((L'.EField (e, x), loc), t)
@@ -555,7 +555,7 @@ fun fooifyExp fk env =
                                       val (se', fm) = fooify fm ((L'.EField (e, x), loc), t)
                                   in
                                       ((L'.EStrcat (se,
-                                                    (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc),
+                                                    (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "/")), loc),
                                                                  se'), loc)), loc),
                                        fm)
                                   end) (se, fm) xts
@@ -585,14 +585,14 @@ fun fooifyExp fk env =
                                             case to of
                                                 NONE =>
                                                 (((L'.PCon (dk, L'.PConVar n, NONE), loc),
-                                                  (L'.EPrim (Prim.String x), loc)),
+                                                  (L'.EPrim (Prim.String (Prim.Normal, x)), loc)),
                                                  fm)
                                               | SOME t =>
                                                 let
                                                     val (arg, fm) = fooify fm ((L'.ERel 0, loc), t)
                                                 in
                                                     (((L'.PCon (dk, L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc),
-                                                      (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc),
+                                                      (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, x ^ "/")), loc),
                                                                    arg), loc)),
                                                      fm)
                                                 end)
@@ -626,10 +626,10 @@ fun fooifyExp fk env =
                     in
                         ((L'.ECase (e,
                                     [((L'.PNone t, loc),
-                                      (L'.EPrim (Prim.String "None"), loc)),
+                                      (L'.EPrim (Prim.String (Prim.Normal, "None")), loc)),
 
                                      ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc),
-                                      (L'.EStrcat ((L'.EPrim (Prim.String "Some/"), loc),
+                                      (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "Some/")), loc),
                                                    body), loc))],
                                     {disc = tAll,
                                      result = (L'.TFfi ("Basis", "string"), loc)}), loc),
@@ -644,9 +644,9 @@ fun fooifyExp fk env =
                                 val (arg, fm) = fooify fm ((L'.ERel 0, loc), rt)
 
                                 val branches = [((L'.PNone rt, loc),
-                                                 (L'.EPrim (Prim.String "Nil"), loc)),
+                                                 (L'.EPrim (Prim.String (Prim.Normal, "Nil")), loc)),
                                                 ((L'.PSome (rt, (L'.PVar ("a", rt), loc)), loc),
-                                                 (L'.EStrcat ((L'.EPrim (Prim.String "Cons/"), loc),
+                                                 (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "Cons/")), loc),
                                                               arg), loc))]
 
                                 val dom = tAll
@@ -742,7 +742,7 @@ fun monoPat env (all as (p, loc)) =
 
 fun strcat loc es =
     case es of
-        [] => (L'.EPrim (Prim.String ""), loc)
+        [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc)
       | [e] => e
       | _ =>
         let
@@ -757,7 +757,7 @@ fun strcat loc es =
 
 fun strcatComma loc es =
     case es of
-        [] => (L'.EPrim (Prim.String ""), loc)
+        [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc)
       | [e] => e
       | _ =>
         let
@@ -766,11 +766,11 @@ fun strcatComma loc es =
         in
             foldr (fn (e, e') =>
                       case (e, e') of
-                          ((L'.EPrim (Prim.String ""), _), _) => e'
-                        | (_, (L'.EPrim (Prim.String ""), _)) => e
+                          ((L'.EPrim (Prim.String (_, "")), _), _) => e'
+                        | (_, (L'.EPrim (Prim.String (_, "")), _)) => e
                         | _ =>
                           (L'.EStrcat (e,
-                                       (L'.EStrcat ((L'.EPrim (Prim.String ", "), loc), e'), loc)), loc))
+                                       (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, ", ")), loc), e'), loc)), loc))
             e1 es
         end
 
@@ -788,7 +788,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
     let
         val strcat = strcat loc
         val strcatComma = strcatComma loc
-        fun str s = (L'.EPrim (Prim.String s), loc)
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
 
         fun poly () =
             (E.errorAt loc "Unsupported expression";
@@ -1564,9 +1565,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.EAbs ("c", s, (L'.TFun (rt, (L'.TFun (un, un), loc)), loc),
                            (L'.EAbs ("r", rt, (L'.TFun (un, un), loc),
                                      (L'.EAbs ("_", un, un,
-                                               (L'.EFfiApp ("Basis", "set_cookie", [((L'.EPrim (Prim.String
-                                                                                                    (Settings.getUrlPrefix ())),
-                                                                                      loc), s),
+                                               (L'.EFfiApp ("Basis", "set_cookie", [(str (Settings.getUrlPrefix ()), s),
                                                                                     ((L'.ERel 2, loc), s),
                                                                                     (e, s),
                                                                                     (fd "Expires", (L'.TOption (L'.TFfi ("Basis", "time"), loc), loc)),
@@ -1583,9 +1582,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.EAbs ("c", s, (L'.TFun (un, un), loc),
                            (L'.EAbs ("_", un, un,
                                      (L'.EFfiApp ("Basis", "clear_cookie",
-                                                  [((L'.EPrim (Prim.String
-                                                                   (Settings.getUrlPrefix ())),
-                                                     loc), s),
+                                                  [(str (Settings.getUrlPrefix ()), s),
                                                    ((L'.ERel 1, loc), s)]),
                                       loc)), loc)), loc),
                  fm)
@@ -1612,8 +1609,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             end
 
           | L.ECApp ((L.EFfi ("Basis", "no_primary_key"), _), _) =>
-            ((L'.EPrim (Prim.String ""), loc),
-             fm)
+            (str "", fm)
           | L.ECApp (
             (L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "primary_key"), _), _), _), t), _),
                       nm), _),
@@ -1623,16 +1619,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val witnesses = (L'.TRecord (map (fn (nm, _) => (monoName env nm, (L'.TRecord [], loc))) unique), loc)
             in
                 ((L'.EAbs ("_", witnesses, (L'.TFfi ("Basis", "string"), loc),
-                           (L'.EPrim (Prim.String
-                                          (String.concatWith ", "
-                                                             (map (fn (x, _) =>
-                                                                      Settings.mangleSql (monoNameLc env x)
-                                                                      ^ (if #textKeysNeedLengths (Settings.currentDbms ())
-                                                                            andalso isBlobby t then
-                                                                             "(767)"
-                                                                         else
-                                                                             "")) unique))),
-                            loc)), loc),
+                           (str
+                                (String.concatWith ", "
+                                                   (map (fn (x, _) =>
+                                                            Settings.mangleSql (monoNameLc env x)
+                                                            ^ (if #textKeysNeedLengths (Settings.currentDbms ())
+                                                                  andalso isBlobby t then
+                                                                   "(767)"
+                                                               else
+                                                                   "")) unique)))),
+                  loc),
                  fm)
             end
 
@@ -1668,15 +1664,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val unique = (nm, t) :: unique
             in
-                ((L'.EPrim (Prim.String ("UNIQUE ("
-                                         ^ String.concatWith ", "
-                                                             (map (fn (x, t) => Settings.mangleSql (monoNameLc env x)
-                                                                                ^ (if #textKeysNeedLengths (Settings.currentDbms ())
-                                                                                      andalso isBlobby t then
-                                                                                       "(767)"
-                                                                                   else
-                                                                                       "")) unique)
-                                         ^ ")")), loc),
+                (str ("UNIQUE ("
+                      ^ String.concatWith ", "
+                                          (map (fn (x, t) => Settings.mangleSql (monoNameLc env x)
+                                                             ^ (if #textKeysNeedLengths (Settings.currentDbms ())
+                                                                   andalso isBlobby t then
+                                                                    "(767)"
+                                                                else
+                                                                    "")) unique)
+                      ^ ")"),
                  fm)
             end
 
@@ -1690,7 +1686,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.EFfi ("Basis", "mat_nil") =>
             let
                 val string = (L'.TFfi ("Basis", "string"), loc)
-                val stringE = (L'.EPrim (Prim.String ""), loc)
+                val stringE = str ""
             in
                 ((L'.ERecord [("1", stringE, string),
                               ("2", stringE, string)], loc), fm)
@@ -1715,21 +1711,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (mat, mat), loc),
                            (L'.EAbs ("m", mat, mat,
                                      (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc),
-                                                [((L'.PPrim (Prim.String ""), loc),
-                                                  (L'.ERecord [("1", (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm1))),
-                                                                      loc), string),
-                                                               ("2", (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm2))),
-                                                                      loc), string)], loc)),
+                                                [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                  (L'.ERecord [("1", str (Settings.mangleSql (lowercaseFirst nm1)),
+                                                                string),
+                                                               ("2", str (Settings.mangleSql (lowercaseFirst nm2)),
+                                                                string)], loc)),
                                                  ((L'.PWild, loc),
                                                   (L'.ERecord [("1", (L'.EStrcat (
-                                                                      (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm1)
-                                                                                              ^ ", ")),
-                                                                       loc),
+                                                                      str (Settings.mangleSql (lowercaseFirst nm1)
+                                                                            ^ ", "),
                                                                       (L'.EField ((L'.ERel 0, loc), "1"), loc)),
                                                                       loc), string),
                                                                ("2", (L'.EStrcat (
-                                                                      (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm2)
-                                                                                              ^ ", ")), loc),
+                                                                      str (Settings.mangleSql (lowercaseFirst nm2)
+                                                                           ^ ", "),
                                                                       (L'.EField ((L'.ERel 0, loc), "2"), loc)),
                                                                       loc), string)],
                                                    loc))],
@@ -1738,10 +1733,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
-          | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => ((L'.EPrim (Prim.String "RESTRICT"), loc), fm)
-          | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => ((L'.EPrim (Prim.String "CASCADE"), loc), fm)
-          | L.ECApp ((L.EFfi ("Basis", "no_action"), _), _) => ((L'.EPrim (Prim.String "NO ACTION"), loc), fm)
-          | L.ECApp ((L.EFfi ("Basis", "set_null"), _), _) => ((L'.EPrim (Prim.String "SET NULL"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => (str "RESTRICT", fm)
+          | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => (str "CASCADE", fm)
+          | L.ECApp ((L.EFfi ("Basis", "no_action"), _), _) => (str "NO ACTION", fm)
+          | L.ECApp ((L.EFfi ("Basis", "set_null"), _), _) => (str "SET NULL", fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -1773,10 +1768,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 fun prop (fd, kw) =
                     (L'.ECase ((L'.EField ((L'.ERel 0, loc), fd), loc),
-                               [((L'.PPrim (Prim.String "NO ACTION"), loc),
-                                 (L'.EPrim (Prim.String ""), loc)),
+                               [((L'.PPrim (Prim.String (Prim.Normal, "NO ACTION")), loc),
+                                 str ""),
                                 ((L'.PWild, loc),
-                                 strcat [(L'.EPrim (Prim.String (" ON " ^ kw ^ " ")), loc),
+                                 strcat [str (" ON " ^ kw ^ " "),
                                          (L'.EField ((L'.ERel 0, loc), fd), loc)])],
                                {disc = string,
                                 result = string}), loc)
@@ -1784,13 +1779,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.EAbs ("m", mat, (L'.TFun (string, (L'.TFun (recd, string), loc)), loc),
                            (L'.EAbs ("tab", string, (L'.TFun (recd, string), loc),
                                      (L'.EAbs ("pr", recd, string,
-                                               strcat [(L'.EPrim (Prim.String "FOREIGN KEY ("), loc),
+                                               strcat [str "FOREIGN KEY (",
                                                        (L'.EField ((L'.ERel 2, loc), "1"), loc),
-                                                       (L'.EPrim (Prim.String ") REFERENCES "), loc),
+                                                       str ") REFERENCES ",
                                                        (L'.ERel 1, loc),
-                                                       (L'.EPrim (Prim.String " ("), loc),
+                                                       str " (",
                                                        (L'.EField ((L'.ERel 2, loc), "2"), loc),
-                                                       (L'.EPrim (Prim.String ")"), loc),
+                                                       str ")",
                                                        prop ("OnDelete", "DELETE"),
                                                        prop ("OnUpdate", "UPDATE")]), loc)), loc)), loc),
                  fm)
@@ -1823,7 +1818,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val string = (L'.TFfi ("Basis", "string"), loc)
             in
                 ((L'.EAbs ("e", string, string,
-                           (L'.EStrcat ((L'.EPrim (Prim.String "CHECK "), loc),
+                           (L'.EStrcat (str "CHECK ",
                                         (L'.EFfiApp ("Basis", "checkString",
                                                      [((L'.ERel 0, loc), string)]), loc)), loc)), loc),
                  fm)
@@ -1852,19 +1847,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                      val s = (L'.TFfi ("Basis", "string"), loc)
                      val fields = map (fn (x, _) => (x, s)) fields
                      val rt = (L'.TRecord fields, loc)
-                     fun sc s = (L'.EPrim (Prim.String s), loc)
                  in
                      ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc),
                                 (L'.EAbs ("fs", rt, s,
-                                          strcat [sc "INSERT INTO ",
+                                          strcat [str "INSERT INTO ",
                                                   (L'.ERel 1, loc),
-                                                  sc " (",
-                                                  strcatComma (map (fn (x, _) => sc (Settings.mangleSql x)) fields),
-                                                  sc ") VALUES (",
+                                                  str " (",
+                                                  strcatComma (map (fn (x, _) => str (Settings.mangleSql x)) fields),
+                                                  str ") VALUES (",
                                                   strcatComma (map (fn (x, _) =>
                                                                        (L'.EField ((L'.ERel 0, loc),
                                                                                    x), loc)) fields),
-                                                  sc ")"]), loc)), loc),
+                                                  str ")"]), loc)), loc),
                       fm)
                  end
                | _ => poly ())
@@ -1876,31 +1870,30 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                      val s = (L'.TFfi ("Basis", "string"), loc)
                      val changed = map (fn (x, _) => (x, s)) changed
                      val rt = (L'.TRecord changed, loc)
-                     fun sc s = (L'.EPrim (Prim.String s), loc)
                  in
                      ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                 (L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
                                           (L'.EAbs ("e", s, s,
                                                     if #supportsUpdateAs (Settings.currentDbms ()) then
-                                                        strcat [sc "UPDATE ",
+                                                        strcat [str "UPDATE ",
                                                                 (L'.ERel 1, loc),
-                                                                sc " AS T_T SET ",
+                                                                str " AS T_T SET ",
                                                                 strcatComma (map (fn (x, _) =>
-                                                                                     strcat [sc (Settings.mangleSql x
+                                                                                     strcat [str (Settings.mangleSql x
                                                                                                  ^ " = "),
                                                                                              (L'.EField
                                                                                                   ((L'.ERel 2,
                                                                                                     loc),
                                                                                                    x), loc)])
                                                                                  changed),
-                                                                sc " WHERE ",
+                                                                str " WHERE ",
                                                                 (L'.ERel 0, loc)]
                                                     else
-                                                        strcat [sc "UPDATE ",
+                                                        strcat [str "UPDATE ",
                                                                 (L'.ERel 1, loc),
-                                                                sc " SET ",
+                                                                str " SET ",
                                                                 strcatComma (map (fn (x, _) =>
-                                                                                     strcat [sc (Settings.mangleSql x
+                                                                                     strcat [str (Settings.mangleSql x
                                                                                                  ^ " = "),
                                                                                              (L'.EFfiApp ("Basis", "unAs",
                                                                                                           [((L'.EField
@@ -1909,7 +1902,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                                                   x), loc),
                                                                                                             s)]), loc)])
                                                                                  changed),
-                                                                sc " WHERE ",
+                                                                str " WHERE ",
                                                                 (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]),
                                            loc)), loc)), loc),
                       fm)
@@ -1919,19 +1912,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "delete"), _), _), _), _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
                            (L'.EAbs ("e", s, s,
                                      if #supportsDeleteAs (Settings.currentDbms ()) then
-                                         strcat [sc "DELETE FROM ",
+                                         strcat [str "DELETE FROM ",
                                                  (L'.ERel 1, loc),
-                                                 sc " AS T_T WHERE ",
+                                                 str " AS T_T WHERE ",
                                                  (L'.ERel 0, loc)]
                                      else
-                                         strcat [sc "DELETE FROM ",
+                                         strcat [str "DELETE FROM ",
                                                  (L'.ERel 1, loc),
-                                                 sc " WHERE ",
+                                                 str " WHERE ",
                                                  (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc),
                  fm)
             end
@@ -1991,7 +1983,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
           | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _), _), _) =>
             let
-                fun sc s = (L'.EPrim (Prim.String s), loc)
                 val s = (L'.TFfi ("Basis", "string"), loc)
                 fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
             in
@@ -2000,9 +1991,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                            s,
                            strcat [gf "Rows",
                                    (L'.ECase (gf "OrderBy",
-                                              [((L'.PPrim (Prim.String ""), loc), sc ""),
+                                              [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), str ""),
                                                ((L'.PWild, loc),
-                                                strcat [sc " ORDER BY ",
+                                                strcat [str " ORDER BY ",
                                                         gf "OrderBy"])],
                                               {disc = s, result = s}), loc),
                                    gf "Limit",
@@ -2025,7 +2016,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
              sexps), _),
             _) =>
             let
-                fun sc s = (L'.EPrim (Prim.String s), loc)
                 val s = (L'.TFfi ("Basis", "string"), loc)
                 val b = (L'.TFfi ("Basis", "bool"), loc)
                 val un = (L'.TRecord [], loc)
@@ -2072,7 +2062,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
                                     loc),
                                    s,
-                                   strcat [sc "SELECT ",
+                                   strcat [str "SELECT ",
                                            (L'.ECase (gf "Distinct",
                                                       [((L'.PCon (L'.Enum,
                                                                   L'.PConFfi {mod = "Basis",
@@ -2080,41 +2070,41 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                               con = "True",
                                                                               arg = NONE},
                                                                   NONE), loc),
-                                                        (L'.EPrim (Prim.String "DISTINCT "), loc)),
+                                                        str "DISTINCT "),
                                                        ((L'.PCon (L'.Enum,
                                                                   L'.PConFfi {mod = "Basis",
                                                                               datatyp = "bool",
                                                                               con = "False",
                                                                               arg = NONE},
                                                                   NONE), loc),
-                                                        (L'.EPrim (Prim.String ""), loc))],
+                                                        str "")],
                                                       {disc = b, result = s}), loc),
                                            strcatComma (map (fn (x, t) =>
                                                                 strcat [
                                                                 (L'.EField (gf "SelectExps", x), loc),
-                                                                sc (" AS " ^ Settings.mangleSql x)
+                                                                str (" AS " ^ Settings.mangleSql x)
                                                             ]) sexps
                                                         @ map (fn (x, xts) =>
                                                                   strcatComma
                                                                       (map (fn (x', _) =>
-                                                                               sc ("T_" ^ x
+                                                                               str ("T_" ^ x
 										   ^ "."
 										   ^ Settings.mangleSql x'))
                                                                            xts)) stables),
                                            (L'.ECase (gf "From",
-                                                      [((L'.PPrim (Prim.String ""), loc),
-                                                        sc ""),
+                                                      [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                        str ""),
                                                        ((L'.PVar ("x", s), loc),
-                                                        strcat [sc " FROM ",
+                                                        strcat [str " FROM ",
                                                                 (L'.ERel 0, loc)])],
                                                       {disc = s,
                                                        result = s}), loc),
                                            (L'.ECase (gf "Where",
-                                                      [((L'.PPrim (Prim.String (#trueString (Settings.currentDbms ()))),
+                                                      [((L'.PPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))),
                                                          loc),
-                                                        sc ""),
+                                                        str ""),
                                                        ((L'.PWild, loc),
-                                                        strcat [sc " WHERE ", gf "Where"])],
+                                                        strcat [str " WHERE ", gf "Where"])],
                                                       {disc = s,
                                                        result = s}), loc),
 
@@ -2125,14 +2115,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                List.all (fn (x, _) =>
                                                                             List.exists (fn (x', _) => x' = x)
                                                                                         xts') xts) tables then
-                                               sc ""
+                                               str ""
                                            else
                                                strcat [
-                                               sc " GROUP BY ",
+                                               str " GROUP BY ",
                                                strcatComma (map (fn (x, xts) =>
                                                                     strcatComma
                                                                         (map (fn (x', _) =>
-                                                                                 sc ("T_" ^ x
+                                                                                 str ("T_" ^ x
 										     ^ "."
 										     ^ Settings.mangleSql x'))
                                                                              xts)) grouped)
@@ -2140,10 +2130,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                                            (L'.ECase (gf "Having",
                                                       [((L'.PPrim (Prim.String
-                                                                       (#trueString (Settings.currentDbms ()))), loc),
-                                                        sc ""),
+                                                                       (Prim.Normal, #trueString (Settings.currentDbms ()))), loc),
+                                                        str ""),
                                                        ((L'.PWild, loc),
-                                                        strcat [sc " HAVING ", gf "Having"])],
+                                                        strcat [str " HAVING ", gf "Having"])],
                                                       {disc = s,
                                                        result = s}), loc)
                                   ]), loc),
@@ -2234,7 +2224,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                      s,
                                      (L'.ECase ((L'.ERel 0, loc),
                                                 [((L'.PNone t, loc),
-                                                  (L'.EPrim (Prim.String "NULL"), loc)),
+                                                  str "NULL"),
                                                  ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc),
                                                   (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))],
                                                 {disc = (L'.TOption t, loc),
@@ -2270,7 +2260,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             ((L'.ERecord [], loc), fm)
 
           | L.ECApp ((L.EFfi ("Basis", "sql_from_nil"), _), _) =>
-            ((L'.EPrim (Prim.String ""), loc), fm)
+            (str "", fm)
           | L.ECApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _),
                                                    _), _), _), _), _), _), _),
                      (L.CName name, _)) =>
@@ -2279,7 +2269,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             in
                 ((L'.EAbs ("tab", s, s,
                            strcat [(L'.ERel 0, loc),
-                                   (L'.EPrim (Prim.String (" AS T_" ^ name)), loc)]), loc),
+                                   str (" AS T_" ^ name)]), loc),
                  fm)
             end
           | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_query"), _), _),
@@ -2287,12 +2277,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                      (L.CName name, _)) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("q", s, s,
-                           strcat [sc "(",
+                           strcat [str "(",
                                    (L'.ERel 0, loc),
-                                   sc (") AS T_" ^ name)]), loc),
+                                   str (") AS T_" ^ name)]), loc),
                  fm)
             end
           | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _), _), _) =>
@@ -2303,13 +2292,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                            (L'.EAbs ("tab2", s, s,
                                      (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), s),
                                                              ("2", (L'.ERel 0, loc), s)], loc),
-                                                [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc),
+                                                [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
                                                   (L'.ERel 0, loc)),
-                                                 ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc),
+                                                 ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
                                                   (L'.ERel 1, loc)),
                                                  ((L'.PWild, loc),
                                                   strcat [(L'.ERel 1, loc),
-                                                          (L'.EPrim (Prim.String ", "), loc),
+                                                          str ", ",
                                                           (L'.ERel 0, loc)])],
                                                 {disc = (L'.TRecord [("1", s), ("2", s)], loc),
                                                  result = s}), loc)), loc)), loc),
@@ -2324,24 +2313,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                      (L'.EAbs ("on", s, s,
                                                (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
                                                                        ("2", (L'.ERel 1, loc), s)], loc),
-                                                          [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc),
+                                                          [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
                                                             (L'.ERel 1, loc)),
-                                                           ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc),
+                                                           ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
                                                             (L'.ERel 2, loc)),
                                                            ((L'.PWild, loc),
                                                             strcat ((if #nestedRelops
                                                                                       (Settings.currentDbms ()) then
-                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                                   [str "("]
                                                                                else
                                                                                    [])
                                                                     @ [(L'.ERel 2, loc),
-                                                                       (L'.EPrim (Prim.String " JOIN "), loc),
+                                                                       str " JOIN ",
                                                                        (L'.ERel 1, loc),
-                                                                       (L'.EPrim (Prim.String " ON "), loc),
+                                                                       str " ON ",
                                                                        (L'.ERel 0, loc)]
                                                                     @ (if #nestedRelops
                                                                               (Settings.currentDbms ()) then
-                                                                           [(L'.EPrim (Prim.String ")"), loc)]
+                                                                           [str ")"]
                                                                        else
                                                                            [])))],
                                                           {disc = (L'.TRecord [("1", s), ("2", s)], loc),
@@ -2360,27 +2349,26 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                (L'.EAbs ("on", s, s,
                                                          (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
                                                                                  ("2", (L'.ERel 1, loc), s)], loc),
-                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String ""),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 1, loc)),
-                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String ""),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
                                                                       strcat ((if #nestedRelops
                                                                                       (Settings.currentDbms ()) then
-                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                                   [str "("]
                                                                                else
                                                                                    [])
                                                                               @ [(L'.ERel 2, loc),
-                                                                                 (L'.EPrim (Prim.String " LEFT JOIN "),
-                                                                                  loc),
+                                                                                 str " LEFT JOIN ",
                                                                                  (L'.ERel 1, loc),
-                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 str " ON ",
                                                                                  (L'.ERel 0, loc)]
                                                                               @ (if #nestedRelops
                                                                                         (Settings.currentDbms ()) then
-                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                     [str ")"]
                                                                                  else
                                                                                      [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
@@ -2399,27 +2387,26 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                (L'.EAbs ("on", s, s,
                                                          (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
                                                                                  ("2", (L'.ERel 1, loc), s)], loc),
-                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String ""),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 1, loc)),
-                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String ""),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
                                                                       strcat ((if #nestedRelops
                                                                                       (Settings.currentDbms ()) then
-                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                                   [str "("]
                                                                                else
                                                                                    [])
                                                                               @ [(L'.ERel 2, loc),
-                                                                                 (L'.EPrim (Prim.String " RIGHT JOIN "),
-                                                                                  loc),
+                                                                                 str " RIGHT JOIN ",
                                                                                  (L'.ERel 1, loc),
-                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 str " ON ",
                                                                                  (L'.ERel 0, loc)]
                                                                               @ (if #nestedRelops
                                                                                         (Settings.currentDbms ()) then
-                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                     [str ")"]
                                                                                  else
                                                                                      [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
@@ -2438,27 +2425,26 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                (L'.EAbs ("on", s, s,
                                                          (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
                                                                                  ("2", (L'.ERel 1, loc), s)], loc),
-                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String ""),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 1, loc)),
-                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String ""),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
                                                                       strcat ((if #nestedRelops
                                                                                       (Settings.currentDbms ()) then
-                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                                   [str "("]
                                                                                else
                                                                                    [])
                                                                               @ [(L'.ERel 2, loc),
-                                                                                 (L'.EPrim (Prim.String " FULL JOIN "),
-                                                                                  loc),
+                                                                                 str " FULL JOIN ",
                                                                                  (L'.ERel 1, loc),
-                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 str " ON ",
                                                                                  (L'.ERel 0, loc)]
                                                                               @ (if #nestedRelops
                                                                                         (Settings.currentDbms ()) then
-                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                     [str ")"]
                                                                                  else
                                                                                      [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
@@ -2467,9 +2453,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             end
 
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
-            ((L'.EPrim (Prim.String ""), loc), fm)
+            (str "", fm)
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_random"), _), _), _), _) =>
-            ((L'.EPrim (Prim.String (#randomFunction (Settings.currentDbms ()) ^ "()")), loc), fm)
+            (str (#randomFunction (Settings.currentDbms ()) ^ "()"), fm)
           | L.ECApp (
             (L.ECApp (
              (L.ECApp (
@@ -2481,81 +2467,80 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                      (L'.EAbs ("d", s, (L'.TFun (s, s), loc),
                                                (L'.EAbs ("e2", s, s,
                                                          (L'.ECase ((L'.ERel 0, loc),
-                                                                    [((L'.PPrim (Prim.String ""), loc),
+                                                                    [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
                                                                       strcat [(L'.ERel 2, loc),
                                                                               (L'.ERel 1, loc)]),
                                                                      ((L'.PWild, loc),
                                                                       strcat [(L'.ERel 2, loc),
                                                                               (L'.ERel 1, loc),
-                                                                              sc ", ",
+                                                                              str ", ",
                                                                               (L'.ERel 0, loc)])],
                                                                     {disc = s, result = s}), loc)), loc)), loc)), loc)), loc),
                  fm)
             end
 
           | L.EFfi ("Basis", "sql_no_limit") =>
-            ((L'.EPrim (Prim.String ""), loc), fm)
+            (str "", fm)
           | L.EFfiApp ("Basis", "sql_limit", [(e, t)]) =>
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
                 (strcat [
-                 (L'.EPrim (Prim.String " LIMIT "), loc),
+                 str " LIMIT ",
                  (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc)
                  ],
                  fm)
             end
 
           | L.EFfi ("Basis", "sql_no_offset") =>
-            ((L'.EPrim (Prim.String ""), loc), fm)
+            (str "", fm)
           | L.EFfiApp ("Basis", "sql_offset", [(e, t)]) =>
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
                 (strcat [
-                 (L'.EPrim (Prim.String " OFFSET "), loc),
+                 str " OFFSET ",
                  (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc)
                  ],
                  fm)
             end
 
           | L.ECApp ((L.EFfi ("Basis", "sql_eq"), _), _) =>
-            ((L'.EPrim (Prim.String "="), loc), fm)
+            (str "=", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_ne"), _), _) =>
-            ((L'.EPrim (Prim.String "<>"), loc), fm)
+            (str "<>", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_lt"), _), _) =>
-            ((L'.EPrim (Prim.String "<"), loc), fm)
+            (str "<", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_le"), _), _) =>
-            ((L'.EPrim (Prim.String "<="), loc), fm)
+            (str "<=", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_gt"), _), _) =>
-            ((L'.EPrim (Prim.String ">"), loc), fm)
+            (str ">", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_ge"), _), _) =>
-            ((L'.EPrim (Prim.String ">="), loc), fm)
+            (str ">=", fm)
 
           | L.ECApp ((L.EFfi ("Basis", "sql_plus"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "+"), loc)), loc), fm)
+                       str "+"), loc), fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_minus"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "-"), loc)), loc), fm)
+                       str "-"), loc), fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_times"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "*"), loc)), loc), fm)
+                       str "*"), loc), fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_div"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "/"), loc)), loc), fm)
+                       str "/"), loc), fm)
           | L.EFfi ("Basis", "sql_mod") =>
-            ((L'.EPrim (Prim.String "%"), loc), fm)
+            (str "%", fm)
 
           | L.EFfi ("Basis", "sql_like") =>
-            ((L'.EPrim (Prim.String "LIKE"), loc), fm)
+            (str "LIKE", fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2570,21 +2555,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
-                                     strcat [sc "(",
+                                     strcat [str "(",
                                              (L'.ERel 1, loc),
-                                             sc " ",
+                                             str " ",
                                              (L'.ERel 0, loc),
-                                             sc ")"]), loc)), loc),
+                                             str ")"]), loc)), loc),
                  fm)
             end
-          | L.EFfi ("Basis", "sql_not") => ((L'.EPrim (Prim.String "NOT"), loc), fm)
+          | L.EFfi ("Basis", "sql_not") => (str "NOT", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_neg"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "-"), loc)), loc), fm)
+                       str "-"), loc), fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2601,22 +2585,21 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                      (L'.EAbs ("e2", s, s,
-                                               strcat [sc "(",
+                                               strcat [str "(",
                                                        (L'.ERel 1, loc),
-                                                       sc " ",
+                                                       str " ",
                                                        (L'.ERel 2, loc),
-                                                       sc " ",
+                                                       str " ",
                                                        (L'.ERel 0, loc),
-                                                       sc ")"]), loc)), loc)), loc),
+                                                       str ")"]), loc)), loc)), loc),
                  fm)
             end
-          | L.EFfi ("Basis", "sql_and") => ((L'.EPrim (Prim.String "AND"), loc), fm)
-          | L.EFfi ("Basis", "sql_or") => ((L'.EPrim (Prim.String "OR"), loc), fm)
+          | L.EFfi ("Basis", "sql_and") => (str "AND", fm)
+          | L.EFfi ("Basis", "sql_or") => (str "OR", fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2632,7 +2615,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                _), _),
               _), _),
              (L.CName tab, _)), _),
-            (L.CName field, _)) => ((L'.EPrim (Prim.String ("T_" ^ tab ^ "." ^ Settings.mangleSql (lowercaseFirst field))), loc), fm)
+            (L.CName field, _)) => (str ("T_" ^ tab ^ "." ^ Settings.mangleSql (lowercaseFirst field)), fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2644,7 +2627,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                _), _),
               _), _),
              _), _),
-            (L.CName nm, _)) => ((L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm))), loc), fm)
+            (L.CName nm, _)) => (str (Settings.mangleSql (lowercaseFirst nm)), fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2661,49 +2644,48 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 (if #nestedRelops (Settings.currentDbms ()) then
                      (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
                                (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                          (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                                    (L'.EAbs ("e2", s, s,
-                                                             strcat [sc "((",
+                                                             strcat [str "((",
                                                                      (L'.ERel 1, loc),
-                                                                     sc ") ",
+                                                                     str ") ",
                                                                      (L'.ERel 3, loc),
                                                                      (L'.ECase ((L'.ERel 2, loc),
                                                                                 [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
                                                                                                                  datatyp = "bool",
                                                                                                                  con = "True",
                                                                                                                  arg = NONE}, NONE), loc),
-                                                                                  sc " ALL"),
+                                                                                  str " ALL"),
                                                                                  ((L'.PWild, loc),
-                                                                                  sc "")],
+                                                                                  str "")],
                                                                                 {disc = (L'.TFfi ("Basis", "bool"), loc),
                                                                                  result = s}), loc),
-                                                                     sc " (",
+                                                                     str " (",
                                                                      (L'.ERel 0, loc),
-                                                                     sc "))"]), loc)), loc)), loc)), loc)
+                                                                     str "))"]), loc)), loc)), loc)), loc)
                  else
                      (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
                                (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                          (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                                    (L'.EAbs ("e2", s, s,
                                                              strcat [(L'.ERel 1, loc),
-                                                                     sc " ",
+                                                                     str " ",
                                                                      (L'.ERel 3, loc),
                                                                      (L'.ECase ((L'.ERel 2, loc),
                                                                                 [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
                                                                                                                  datatyp = "bool",
                                                                                                                  con = "True",
                                                                                                                  arg = NONE}, NONE), loc),
-                                                                                  sc " ALL"),
+                                                                                  str " ALL"),
                                                                                  ((L'.PWild, loc),
-                                                                                  sc "")],
+                                                                                  str "")],
                                                                                 {disc = (L'.TFfi ("Basis", "bool"), loc),
                                                                                  result = s}), loc),
-                                                                     sc " ",
+                                                                     str " ",
                                                                      (L'.ERel 0, loc)]), loc)), loc)), loc)), loc),
                  fm)
             end
@@ -2720,25 +2702,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("x", s, s, (L'.ERel 0, loc)), loc),
                  fm)
             end
 
-          | L.EFfi ("Basis", "sql_union") => ((L'.EPrim (Prim.String "UNION"), loc), fm)
+          | L.EFfi ("Basis", "sql_union") => (str "UNION", fm)
           | L.EFfi ("Basis", "sql_intersect") =>
             (if #onlyUnion (Settings.currentDbms ()) then
                  ErrorMsg.errorAt loc "The DBMS you've selected doesn't support INTERSECT."
              else
                  ();
-             ((L'.EPrim (Prim.String "INTERSECT"), loc), fm))
+             (str "INTERSECT", fm))
           | L.EFfi ("Basis", "sql_except") =>
             (if #onlyUnion (Settings.currentDbms ()) then
                  ErrorMsg.errorAt loc "The DBMS you've selected doesn't support EXCEPT."
              else
                  ();
-             ((L'.EPrim (Prim.String "EXCEPT"), loc), fm))
+             (str "EXCEPT", fm))
 
           | L.ECApp (
             (L.ECApp (
@@ -2746,8 +2727,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
               (L.EFfi ("Basis", "sql_count"), _),
               _), _),
              _), _),
-            _) => ((L'.EPrim (Prim.String "COUNT(*)"), loc),
-                   fm)
+            _) => (str "COUNT(*)", fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2762,12 +2742,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             t) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
 
                 val main = strcat [(L'.ERel 1, loc),
-                                   sc "(",
+                                   str "(",
                                    (L'.ERel 0, loc),
-                                   sc ")"]
+                                   str ")"]
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc),
@@ -2775,8 +2754,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             end
 
           | L.ECApp ((L.EFfi ("Basis", "sql_count_col"), _), _) =>
-            ((L'.EPrim (Prim.String "COUNT"), loc),
-             fm)
+            (str "COUNT", fm)
 
           | L.EFfi ("Basis", "sql_summable_int") => ((L'.ERecord [], loc), fm)
           | L.EFfi ("Basis", "sql_summable_float") => ((L'.ERecord [], loc), fm)
@@ -2786,12 +2764,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
              fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                       (L'.EPrim (Prim.String "AVG"), loc)), loc),
+                       str "AVG"), loc),
              fm)
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_sum"), _), _), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
                        (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                                 (L'.EPrim (Prim.String "SUM"), loc)), loc)), loc),
+                                 str "SUM"), loc)), loc),
              fm)
 
           | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm)
@@ -2811,16 +2789,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_max"), _), _), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
                        (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                                 (L'.EPrim (Prim.String "MAX"), loc)), loc)), loc),
+                                 str "MAX"), loc)), loc),
              fm)
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_min"), _), _), _), _) =>
             ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
                        (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
-                                 (L'.EPrim (Prim.String "MIN"), loc)), loc)), loc),
+                                 str "MIN"), loc)), loc),
              fm)
 
-          | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
-          | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
+          | L.EFfi ("Basis", "sql_asc") => (str "", fm)
+          | L.EFfi ("Basis", "sql_desc") => (str " DESC", fm)
           | L.ECApp (
             (L.ECApp (
              (L.ECApp (
@@ -2832,7 +2810,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
            _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc),
                  fm)
@@ -2860,7 +2837,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
-          | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm)
+          | L.EFfi ("Basis", "sql_current_timestamp") => (str "CURRENT_TIMESTAMP", fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -2875,25 +2852,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("f", s, (L'.TFun (s, s), loc),
                            (L'.EAbs ("x", s, s,
                                      strcat [(L'.ERel 1, loc),
-                                             sc "(",
+                                             str "(",
                                              (L'.ERel 0, loc),
-                                             sc ")"]), loc)), loc),
+                                             str ")"]), loc)), loc),
                  fm)
             end
           | L.EFfi ("Basis", "sql_octet_length") =>
-            ((L'.EPrim (Prim.String (if #supportsOctetLength (Settings.currentDbms ()) then
-                                         "octet_length"
-                                     else
-                                         "length")), loc), fm)
+            (str (if #supportsOctetLength (Settings.currentDbms ()) then
+                      "octet_length"
+                  else
+                      "length"), fm)
           | L.EFfi ("Basis", "sql_lower") =>
-            ((L'.EPrim (Prim.String "lower"), loc), fm)
+            (str "lower", fm)
           | L.EFfi ("Basis", "sql_upper") =>
-            ((L'.EPrim (Prim.String "upper"), loc), fm)
+            (str "upper", fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) =>
             ((L'.EFfi ("Basis", "sql_known"), loc), fm)
 
@@ -2907,12 +2883,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
               _), _)) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("s", s, s,
-                           strcat [sc "(",
+                           strcat [str "(",
                                    (L'.ERel 0, loc),
-                                   sc " IS NULL)"]), loc),
+                                   str " IS NULL)"]), loc),
                  fm)
             end
 
@@ -2926,15 +2901,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
               _), _)) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("x1", s, (L'.TFun (s, s), loc),
                            (L'.EAbs ("x1", s, s,
-                                     strcat [sc "COALESCE(",
+                                     strcat [str "COALESCE(",
                                              (L'.ERel 1, loc),
-                                             sc ",",
+                                             str ",",
                                              (L'.ERel 0, loc),
-                                             sc ")"]), loc)), loc),
+                                             str ")"]), loc)), loc),
                  fm)
             end
 
@@ -2948,18 +2922,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
               _), _)) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("if", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("then", s, (L'.TFun (s, s), loc),
                                      (L'.EAbs ("else", s, s,
-                                               strcat [sc "(CASE WHEN (",
+                                               strcat [str "(CASE WHEN (",
                                                        (L'.ERel 2, loc),
-                                                       sc ") THEN (",
+                                                       str ") THEN (",
                                                        (L'.ERel 1, loc),
-                                                       sc ") ELSE (",
+                                                       str ") ELSE (",
                                                        (L'.ERel 0, loc),
-                                                       sc ") END)"]), loc)), loc)), loc),
+                                                       str ") END)"]), loc)), loc)), loc),
                  fm)
             end
 
@@ -2974,7 +2947,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("u", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
                            (L'.EAbs ("x", s, s,
@@ -2997,13 +2969,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
                            (L'.EAbs ("x", s, s,
-                                     strcat [sc "(",
+                                     strcat [str "(",
                                              (L'.ERel 0, loc),
-                                             sc ")"]), loc)), loc),
+                                             str ")"]), loc)), loc),
                  fm)
             end
 
@@ -3013,7 +2984,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                (L.EFfi ("Basis", "sql_no_partition"), _),
                _), _),
              _), _),
-            _) => ((L'.EPrim (Prim.String ""), loc), fm)
+            _) => (str "", fm)
           | L.ECApp (
             (L.ECApp (
              (L.ECApp (
@@ -3026,7 +2997,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
             in
-                ((L'.EAbs ("e", s, s, strcat [(L'.EPrim (Prim.String "PARTITION BY "), loc), (L'.ERel 0, loc)]), loc),
+                ((L'.EAbs ("e", s, s, strcat [str "PARTITION BY ", (L'.ERel 0, loc)]), loc),
                  fm)
             end
 
@@ -3046,20 +3017,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                              ErrorMsg.errorAt loc "The DBMS you've selected doesn't support window functions."
 
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
 
                 val main = strcat [(L'.ERel 2, loc),
-                                   sc " OVER (",
+                                   str " OVER (",
                                    (L'.ERel 1, loc),
                                    (L'.ECase ((L'.ERel 0, loc),
-                                              [((L'.PPrim (Prim.String ""), loc),
-                                                sc ""),
+                                              [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                str ""),
                                                ((L'.PWild, loc),
-                                                strcat [sc " ORDER BY ",
+                                                strcat [str " ORDER BY ",
                                                         (L'.ERel 0, loc)])],
                                               {disc = s,
                                                result = s}), loc),
-                                   sc ")"]
+                                   str ")"]
             in
                 ((L'.EAbs ("w", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("p", s, (L'.TFun (s, s), loc),
@@ -3081,12 +3051,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
 
                 val main = strcat [(L'.ERel 1, loc),
-                                   sc "(",
+                                   str "(",
                                    (L'.ERel 0, loc),
-                                   sc ")"]
+                                   str ")"]
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, s, main), loc)), loc),
@@ -3094,9 +3063,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             end
 
           | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) =>
-            ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm)
+            (str "COUNT(*)", fm)
           | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_rank"), _), _), _), _), _), _) =>
-            ((L'.EPrim (Prim.String "RANK()"), loc), fm)
+            (str "RANK()", fm)
 
           | L.EFfiApp ("Basis", "nextval", [(e, _)]) =>
             let
@@ -3112,19 +3081,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.ESetval (e1, e2), loc), fm)
             end
 
-          | L.EFfi ("Basis", "null") => ((L'.EPrim (Prim.String ""), loc), fm)
+          | L.EFfi ("Basis", "null") => (str "", fm)
 
           | L.EFfiApp ("Basis", "classes", [(s1, _), (s2, _)]) =>
             let
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc),
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
                  fm)
             end
 
-          | L.EFfi ("Basis", "data_kind") => ((L'.EPrim (Prim.String "data-"), loc), fm)
-          | L.EFfi ("Basis", "aria_kind") => ((L'.EPrim (Prim.String "aria-"), loc), fm)
+          | L.EFfi ("Basis", "data_kind") => (str "data-", fm)
+          | L.EFfi ("Basis", "aria_kind") => (str "aria-", fm)
 
           | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) =>
             let
@@ -3134,9 +3103,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             in
                 ((L'.EStrcat (sk,
                               (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc),
-                                           (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc),
+                                           (L'.EStrcat (str "=\"",
                                                         (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc),
-                                                                     (L'.EPrim (Prim.String "\""), loc)), loc)),
+                                                                     str "\""), loc)),
                                             loc)), loc)), loc),
                  fm)
             end
@@ -3146,7 +3115,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc),
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
                  fm)
             end
 
@@ -3154,9 +3123,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val (s, fm) = monoExp (env, st, fm) s
             in
-                ((L'.EStrcat ((L'.EPrim (Prim.String "url("), loc),
+                ((L'.EStrcat (str "url(",
                               (L'.EStrcat ((L'.EFfiApp ("Basis", "css_url", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
-                                           (L'.EPrim (Prim.String ")"), loc)), loc)), loc),
+                                           str ")"), loc)), loc),
                  fm)
             end
 
@@ -3165,7 +3134,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val (s, fm) = monoExp (env, st, fm) s
             in
                 ((L'.EStrcat ((L'.EFfiApp ("Basis", "property", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
-                              (L'.EPrim (Prim.String ":"), loc)), loc),
+                              str ":"), loc),
                  fm)
             end
           | L.EFfiApp ("Basis", "value", [(s1, _), (s2, _)]) =>
@@ -3173,17 +3142,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc),
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
                  fm)
             end
 
-          | L.EFfi ("Basis", "noStyle") => ((L'.EPrim (Prim.String ""), loc), fm)
+          | L.EFfi ("Basis", "noStyle") => (str "", fm)
           | L.EFfiApp ("Basis", "oneProperty", [(s1, _), (s2, _)]) =>
             let
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat (s1, (L'.EStrcat (s2, (L'.EPrim (Prim.String ";"), loc)), loc)), loc),
+                ((L'.EStrcat (s1, (L'.EStrcat (s2, str ";"), loc)), loc),
                  fm)
             end
 
@@ -3332,28 +3301,28 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 fun tagStart tag' =
                     let
                         val t = (L'.TFfi ("Basis", "string"), loc)
-                        val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc)
+                        val s = strH (String.concat ["<", tag'])
 
                         val s = (L'.EStrcat (s,
                                              (L'.ECase (class,
-                                                        [((L'.PPrim (Prim.String ""), loc),
-                                                          (L'.EPrim (Prim.String ""), loc)),
+                                                        [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                          strH ""),
                                                          ((L'.PVar ("x", t), loc),
-                                                          (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
+                                                          (L'.EStrcat (strH " class=\"",
                                                                        (L'.EStrcat ((L'.ERel 0, loc),
-                                                                                    (L'.EPrim (Prim.String "\""), loc)),
+                                                                                    strH "\""),
                                                                         loc)), loc))],
                                                         {disc = t,
                                                          result = t}), loc)), loc)
 
                         val s = (L'.EStrcat (s,
                                              (L'.ECase (style,
-                                                        [((L'.PPrim (Prim.String ""), loc),
-                                                          (L'.EPrim (Prim.String ""), loc)),
+                                                        [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                          strH ""),
                                                          ((L'.PVar ("x", t), loc),
-                                                          (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc),
+                                                          (L'.EStrcat (strH " style=\"",
                                                                        (L'.EStrcat ((L'.ERel 0, loc),
-                                                                                    (L'.EPrim (Prim.String "\""), loc)),
+                                                                                    strH "\""),
                                                                         loc)), loc))],
                                                         {disc = t,
                                                          result = t}), loc)), loc)
@@ -3363,7 +3332,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                               | (("Data", e, _), (s, fm)) =>
                                                 ((L'.EStrcat (s,
                                                               (L'.EStrcat (
-                                                               (L'.EPrim (Prim.String " "), loc),
+                                                               strH " ",
                                                                e), loc)), loc),
                                                  fm)
                                               | ((x, e, t), (s, fm)) =>
@@ -3380,7 +3349,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                             arg = NONE},
                                                                                 NONE), loc),
                                                                       (L'.EStrcat (s,
-                                                                                   (L'.EPrim (Prim.String s'), loc)), loc)),
+                                                                                   strH s'), loc)),
                                                                      ((L'.PCon (L'.Enum,
                                                                                 L'.PConFfi {mod = "Basis",
                                                                                             datatyp = "bool",
@@ -3409,10 +3378,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                     in
                                                         ((L'.EStrcat (s,
                                                                       (L'.EStrcat (
-                                                                       (L'.EPrim (Prim.String s'), loc),
+                                                                       strH s',
                                                                        (L'.EStrcat (
                                                                         (L'.EJavaScript (L'.Attribute, e), loc),
-                                                                        (L'.EPrim (Prim.String ");return false'"), loc)), loc)),
+                                                                        strH ");return false'"), loc)),
                                                                        loc)), loc),
                                                          fm)
                                                     end
@@ -3438,14 +3407,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                                                         val (e, fm) = fooify env fm (e, t)
                                                         val e = case (tag, x) of
-                                                                    ("coption", "Value") => (L'.EStrcat ((L'.EPrim (Prim.String "x"), loc), e), loc)
+                                                                    ("coption", "Value") => (L'.EStrcat (strH "x", e), loc)
                                                                   | _ => e
                                                     in
                                                         ((L'.EStrcat (s,
-                                                                      (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
+                                                                      (L'.EStrcat (strH xp,
                                                                                    (L'.EStrcat (e,
-                                                                                                (L'.EPrim (Prim.String "\""),
-                                                                                                 loc)),
+                                                                                                strH "\""),
                                                                                     loc)),
                                                                        loc)), loc),
                                                          fm)
@@ -3454,7 +3422,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                     in
                         (if tag = "coption" andalso List.all (fn ("Value", _, _) => false | _ => true) attrs then
                             (L'.EStrcat (s,
-                                         (L'.EPrim (Prim.String " value=\"\""), loc)), loc)
+                                         strH " value=\"\""), loc)
                          else
                              s,
                          fm)
@@ -3467,8 +3435,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             val (ts, fm) = tagStart "input"
                         in
                             ((L'.EStrcat (ts,
-                                          (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")),
-                                           loc)), loc), fm)
+                                          strH (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")), loc), fm)
                         end
                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                               raise Fail "No name passed to input tag")
@@ -3488,10 +3455,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                               NONE => xml
                                             | SOME extra => (L'.EStrcat (extra, xml), loc)
                             in
-                                ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
+                                ((L'.EStrcat ((L'.EStrcat (tagStart, strH ">"), loc),
                                               (L'.EStrcat (xml,
-                                                           (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])),
-                                                            loc)), loc)),
+                                                           strH (String.concat ["</", tag, ">"])), loc)),
                                   loc),
                                  fm)
                             end
@@ -3511,9 +3477,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                        (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
                                                  _), _),
                                        _), _),
-                                      (L.EPrim (Prim.String s), _)), _), NONE) =>
+                                      (L.EPrim (Prim.String (_, s)), _)), _), NONE) =>
                             if CharVector.all Char.isSpace s andalso isSingleton () then
-                                ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm)
+                                ((L'.EStrcat (tagStart, strH " />"), loc), fm)
                             else
                                 normal ()
                           | _ => normal ()
@@ -3521,7 +3487,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 fun setAttrs jexp =
                     let
-                        val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
+                        val s = strH (String.concat ["<", tag])
 
                         val assgns = List.mapPartial
                                      (fn ("Source", _, _) => NONE
@@ -3570,12 +3536,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                         val t = (L'.TFfi ("Basis", "string"), loc)
                         val setClass = (L'.ECase (class,
-                                                  [((L'.PPrim (Prim.String ""), loc),
+                                                  [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
                                                     str ""),
                                                    ((L'.PVar ("x", t), loc),
-                                                    (L'.EStrcat ((L'.EPrim (Prim.String "d.className=\""), loc),
+                                                    (L'.EStrcat (strH "d.className=\"",
                                                                  (L'.EStrcat ((L'.ERel 0, loc),
-                                                                              (L'.EPrim (Prim.String "\";"), loc)), loc)),
+                                                                              strH "\";"), loc)),
                                                      loc))],
                                                   {disc = (L'.TOption t, loc),
                                                    result = t}), loc)
@@ -3594,14 +3560,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 fun execify e =
                     case e of
-                        NONE => (L'.EPrim (Prim.String ""), loc)
+                        NONE => strH ""
                       | SOME e =>
                         let
                             val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
                         in
-                            (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
+                            (L'.EStrcat (strH "exec(",
                                          (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
-                                                      (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
+                                                      strH ")"), loc)), loc)
                         end
 
                 fun inTag tag' = case ctxOuter of
@@ -3643,10 +3609,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             case attrs of
 				[("Signal", e, _)] =>
 				((L'.EStrcat
-                                      ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
-                                                               ^ pnode () ^ "\", execD(")), loc),
+                                      (strH ("<script type=\"text/javascript\">dyn(\""
+                                             ^ pnode () ^ "\", execD("),
                                        (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
-                                                    (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
+                                                    strH ("))</script>")), loc)), loc),
 				 fm)
                               | _ => raise Fail "Monoize: Bad <dyn> attributes"
 			end
@@ -3655,9 +3621,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         (case attrs of
 			     [("Code", e, _)] =>
 			     ((L'.EStrcat
-                                   ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">active(execD(")), loc),
+                                   (strH "<script type=\"text/javascript\">active(execD(",
                                     (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
-                                                 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
+                                                 strH "))</script>"), loc)), loc),
 			      fm)
                            | _ => raise Fail "Monoize: Bad <active> attributes")
 
@@ -3665,9 +3631,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         (case attrs of
 			     [("Code", e, _)] =>
 			     ((L'.EStrcat
-                                   ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">execF(execD(")), loc),
+                                   (strH "<script type=\"text/javascript\">execF(execD(",
                                     (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
-                                                 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
+                                                 strH "))</script>"), loc)), loc),
 			      fm)
                            | _ => raise Fail "Monoize: Bad <script> attributes")
 
@@ -3684,8 +3650,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                       val (ts, fm) = tagStart "input"
 				  in
                                       ((L'.EStrcat (ts,
-                                                    (L'.EPrim (Prim.String (" type=\"text\" name=\"" ^ name ^ "\" />")),
-                                                     loc)), loc), fm)
+                                                    strH (" type=\"text\" name=\"" ^ name ^ "\" />")),
+                                        loc), fm)
 				  end
 				| SOME (_, src, _) =>
 				  (strcat [str "<script type=\"text/javascript\">inp(exec(",
@@ -3705,10 +3671,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				 val (xml, fm) = monoExp (env, st, fm) xml
                              in
 				 ((L'.EStrcat ((L'.EStrcat (ts,
-                                                            (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc),
+                                                            strH (" name=\"" ^ name ^ "\">")), loc),
                                                (L'.EStrcat (xml,
-                                                            (L'.EPrim (Prim.String "</textarea>"),
-                                                             loc)), loc)),
+                                                            strH "</textarea>"), loc)),
                                    loc), fm)
                              end
                            | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
@@ -3728,7 +3693,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                              NONE => raise Fail "No name for radioGroup"
                            | SOME name =>
                              normal ("input",
-                                     SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc)))
+                                     SOME (strH (" type=\"radio\" name=\"" ^ name ^ "\""))))
 
                       | "select" =>
 			(case targs of
@@ -3738,11 +3703,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				 val (xml, fm) = monoExp (env, st, fm) xml
                              in
 				 ((L'.EStrcat ((L'.EStrcat (ts,
-                                                            (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")),
-                                                             loc)), loc),
+                                                            strH (" name=\"" ^ name ^ "\">")), loc),
                                                (L'.EStrcat (xml,
-                                                            (L'.EPrim (Prim.String "</select>"),
-                                                             loc)), loc)),
+                                                            strH "</select>"),
+                                                loc)),
                                    loc),
 				  fm)
                              end
@@ -3756,7 +3720,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				 val (ts, fm) = tagStart "input"
                              in
 				 ((L'.EStrcat (ts,
-                                               (L'.EPrim (Prim.String " type=\"text\" />"), loc)),
+                                               strH " type=\"text\" />"),
                                    loc), fm)
                              end
                            | SOME (_, src, _) =>
@@ -3779,7 +3743,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				 val (ts, fm) = tagStart "input type=\"checkbox\""
                              in
 				 ((L'.EStrcat (ts,
-                                               (L'.EPrim (Prim.String " />"), loc)),
+                                               strH " />"),
                                    loc), fm)
                              end
                            | SOME (_, src, _) =>
@@ -3834,7 +3798,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				 val (ts, fm) = tagStart "textarea"
                              in
 				 ((L'.EStrcat (ts,
-                                               (L'.EPrim (Prim.String " />"), loc)),
+                                               strH " />"),
                                    loc), fm)
                              end
                            | SOME (_, src, _) =>
@@ -3957,7 +3921,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                       | _ => NotFound
 
                 val (func, action, fm) = case findSubmit xml of
-                    NotFound => (0, (L'.EPrim (Prim.String ""), loc), fm)
+                    NotFound => (0, strH "", fm)
                   | Error => raise Fail "Not ready for multi-submit lforms yet"
                   | Found (action, actionT) =>
                     let
@@ -3969,9 +3933,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         val (action, fm) = urlifyExp env fm (action, actionT)
                     in
                         (func,
-                         (L'.EStrcat ((L'.EPrim (Prim.String " action=\""), loc),
+                         (L'.EStrcat (strH " action=\"",
                                       (L'.EStrcat (action,
-                                                   (L'.EPrim (Prim.String "\""), loc)), loc)), loc),
+                                                   strH "\""), loc)), loc),
                          fm)
                     end
 
@@ -4010,12 +3974,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                             val sigName = getSigName ()
                             val sigSet = (L'.EFfiApp ("Basis", "sigString", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc)
-                            val sigSet = (L'.EStrcat ((L'.EPrim (Prim.String ("<input type=\"hidden\" name=\""
-                                                                              ^ sigName
-                                                                              ^ "\" value=\"")), loc),
+                            val sigSet = (L'.EStrcat (strH ("<input type=\"hidden\" name=\""
+                                                            ^ sigName
+                                                            ^ "\" value=\""),
                                                       sigSet), loc)
                             val sigSet = (L'.EStrcat (sigSet,
-                                                      (L'.EPrim (Prim.String "\" />"), loc)), loc)
+                                                      strH "\" />"), loc)
                         in
                             (L'.EStrcat (sigSet, xml), loc)
                         end
@@ -4024,7 +3988,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 val action = if hasUpload then
                                  (L'.EStrcat (action,
-                                              (L'.EPrim (Prim.String " enctype=\"multipart/form-data\""), loc)), loc)
+                                              strH " enctype=\"multipart/form-data\""), loc)
                              else
                                  action
 
@@ -4033,19 +3997,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val action = (L'.EStrcat (action,
                                           (L'.ECase (class,
                                                      [((L'.PNone stt, loc),
-                                                       (L'.EPrim (Prim.String ""), loc)),
+                                                       strH ""),
                                                       ((L'.PSome (stt, (L'.PVar ("x", stt), loc)), loc),
-                                                       (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
+                                                       (L'.EStrcat (strH " class=\"",
                                                                     (L'.EStrcat ((L'.ERel 0, loc),
-                                                                                 (L'.EPrim (Prim.String "\""), loc)), loc)), loc))],
+                                                                                 strH "\""), loc)), loc))],
                                                      {disc = (L'.TOption stt, loc),
                                                       result = stt}), loc)), loc)
             in
-                ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
+                ((L'.EStrcat ((L'.EStrcat (strH "<form method=\"post\"",
                                            (L'.EStrcat (action,
-                                                        (L'.EPrim (Prim.String ">"), loc)), loc)), loc),
+                                                        strH ">"), loc)), loc),
                               (L'.EStrcat (xml,
-                                           (L'.EPrim (Prim.String "</form>"), loc)), loc)), loc),
+                                           strH "</form>"), loc)), loc),
                  fm)
             end
 
@@ -4056,10 +4020,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val s = (L'.TFfi ("Basis", "string"), loc)
             in
                 ((L'.EAbs ("xml", s, s,
-                           strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".b\" value=\""
-                                                           ^ nm ^ "\" />")), loc),
+                           strcat [strH ("<input type=\"hidden\" name=\".b\" value=\""
+                                         ^ nm ^ "\" />"),
                                    (L'.ERel 0, loc),
-                                   (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
                   loc),
                  fm)
             end
@@ -4071,10 +4035,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val s = (L'.TFfi ("Basis", "string"), loc)
             in
                 ((L'.EAbs ("xml", s, s,
-                           strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".s\" value=\""
-                                                           ^ nm ^ "\" />")), loc),
+                           strcat [strH ("<input type=\"hidden\" name=\".s\" value=\""
+                                         ^ nm ^ "\" />"),
                                    (L'.ERel 0, loc),
-                                   (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
                   loc),
                  fm)
             end
@@ -4085,9 +4049,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val s = (L'.TFfi ("Basis", "string"), loc)
             in
                 ((L'.EAbs ("xml", s, s,
-                           strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".i\" value=\"1\" />")), loc),
+                           strcat [strH ("<input type=\"hidden\" name=\".i\" value=\"1\" />"),
                                    (L'.ERel 0, loc),
-                                   (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
                   loc),
                  fm)
             end
@@ -4175,7 +4139,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val (e, fm) = monoExp (env, st, fm) e
                 val (e, fm) = urlifyExp env fm (e, dummyTyp)
             in
-                ((L'.EStrcat ((L'.EPrim (Prim.String (Settings.getUrlPrePrefix ())), loc), e), loc), fm)
+                ((L'.EStrcat (str (Settings.getUrlPrePrefix ()), e), loc), fm)
             end
 
           | L.EApp (e1, e2) =>
@@ -4296,14 +4260,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             val (e, fm) = urlifyExp env fm (e, monoType env dom)
                         in
                             encodeArgs (es, ran, e
-                                                 :: (L'.EPrim (Prim.String "/"), loc)
+                                                 :: str "/"
                                                  :: acc, fm)
                         end
                       | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type"
 
                 val (call, fm) = encodeArgs (es, ft, [], fm)
                 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
-                                 (L'.EPrim (Prim.String name), loc) call
+                                 (str name) call
 
                 val unit = (L'.TRecord [], loc)
 
@@ -4329,6 +4293,9 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             (E.errorAt loc "Unsupported declaration";
              Print.eprefaces' [("Declaration", CorePrint.p_decl env all)];
              NONE)
+
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
     in
         case d of
             L.DCon _ => NONE
@@ -4426,7 +4393,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
                 val s = Settings.mangleSqlTable s
-                val e_name = (L'.EPrim (Prim.String s), loc)
+                val e_name = str s
 
                 val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
 
@@ -4444,7 +4411,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
                 val s = Settings.mangleSqlTable s
-                val e_name = (L'.EPrim (Prim.String s), loc)
+                val e_name = str s
 
                 val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
 
@@ -4462,7 +4429,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
                 val s = Settings.mangleSql s
-                val e = (L'.EPrim (Prim.String s), loc)
+                val e = str s
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
@@ -4474,7 +4441,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             let
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
-                val e = (L'.EPrim (Prim.String s), loc)
+                val e = str s
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
@@ -4485,7 +4452,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             let
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
-                val e = (L'.EPrim (Prim.String s), loc)
+                val e = strH s
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
@@ -4581,6 +4548,9 @@ fun monoize env file =
         val client = (L'.TFfi ("Basis", "client"), loc)
         val unit = (L'.TRecord [], loc)
 
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
+
         fun calcClientish xts =
             foldl (fn ((x : L.con, t : L.con), st as (nullable, notNullable)) =>
                       case #1 x of
@@ -4610,22 +4580,22 @@ fun monoize env file =
                             val (nullable, notNullable) = calcClientish xts
 
                             fun cond (x, v) =
-                                (L'.EStrcat ((L'.EPrim (Prim.String (Settings.mangleSql x
-                                                                     ^ (case v of
-                                                                            Client => ""
-                                                                          | Channel => " >> 32")
-                                                                     ^ " = ")), loc),
+                                (L'.EStrcat (str (Settings.mangleSql x
+                                                  ^ (case v of
+                                                         Client => ""
+                                                       | Channel => " >> 32")
+                                                  ^ " = "),
                                              target), loc)
 
                             val e =
                                 foldl (fn ((x, v), e) =>
                                           (L'.ESeq (
                                            (L'.EDml ((L'.EStrcat (
-                                                      (L'.EPrim (Prim.String ("UPDATE "
-                                                                              ^ Settings.mangleSql tab
-                                                                              ^ " SET "
-                                                                              ^ Settings.mangleSql x
-                                                                              ^ " = NULL WHERE ")), loc),
+                                                      str ("UPDATE "
+                                                           ^ Settings.mangleSql tab
+                                                           ^ " SET "
+                                                           ^ Settings.mangleSql x
+                                                           ^ " = NULL WHERE "),
                                                       cond (x, v)), loc), L'.Error), loc),
                                            e), loc))
                                       e nullable
@@ -4638,12 +4608,11 @@ fun monoize env file =
                                      (L'.EDml (foldl
                                                    (fn (eb, s) =>
                                                        (L'.EStrcat (s,
-                                                                    (L'.EStrcat ((L'.EPrim (Prim.String " OR "),
-                                                                                  loc),
+                                                                    (L'.EStrcat (str " OR ",
                                                                                  cond eb), loc)), loc))
-                                                   (L'.EStrcat ((L'.EPrim (Prim.String ("DELETE FROM "
-                                                                                        ^ Settings.mangleSql tab
-                                                                                        ^ " WHERE ")), loc),
+                                                   (L'.EStrcat (str ("DELETE FROM "
+                                                                     ^ Settings.mangleSql tab
+                                                                     ^ " WHERE "),
                                                                 cond eb), loc)
                                                    ebs, L'.Error), loc),
                                      e), loc)
@@ -4673,15 +4642,15 @@ fun monoize env file =
                                     [] => e
                                   | (x, _) :: ebs =>
                                     (L'.ESeq (
-                                     (L'.EDml ((L'.EPrim (Prim.String
-                                                              (foldl (fn ((x, _), s) =>
-                                                                         s ^ ", " ^ Settings.mangleSql x ^ " = NULL")
-                                                                     ("UPDATE uw_"
-                                                                      ^ tab
-                                                                      ^ " SET "
-                                                                      ^ Settings.mangleSql x
+                                     (L'.EDml (str
+                                                   (foldl (fn ((x, _), s) =>
+                                                              s ^ ", " ^ Settings.mangleSql x ^ " = NULL")
+                                                          ("UPDATE uw_"
+                                                           ^ tab
+                                                           ^ " SET "
+                                                           ^ Settings.mangleSql x
                                                                       ^ " = NULL")
-                                                                     ebs)), loc), L'.Error), loc),
+                                                          ebs), L'.Error), loc),
                                      e), loc)
 
                             val e =
@@ -4689,8 +4658,8 @@ fun monoize env file =
                                     [] => e
                                   | eb :: ebs =>
                                     (L'.ESeq (
-                                     (L'.EDml ((L'.EPrim (Prim.String ("DELETE FROM "
-                                                                       ^ Settings.mangleSql tab)), loc), L'.Error), loc),
+                                     (L'.EDml (str ("DELETE FROM "
+                                                    ^ Settings.mangleSql tab), L'.Error), loc),
                                      e), loc)
                         in
                             e
diff --git a/src/pathcheck.sml b/src/pathcheck.sml
index c1bb667b..3533032e 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -88,7 +88,7 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) =
 
                 val rels = #2 (doRel s)
                 val rels = case #1 pe of
-                               EPrim (Prim.String "") => rels
+                               EPrim (Prim.String (_, "")) => rels
                              | _ =>
                                let
                                    val s' = s ^ "_Pkey"
diff --git a/src/prepare.sml b/src/prepare.sml
index 89cd1b43..660173f0 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -65,7 +65,7 @@ fun prepString (e, st) =
                     SOME (#p_blank (Settings.currentDbms ()) (n + 1, t) :: ss, n + 1)
             in
                 case #1 e of
-                    EPrim (Prim.String s) =>
+                    EPrim (Prim.String (_, s)) =>
                     SOME (s :: ss, n)
                   | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) =>
                     (case prepString' (e1, ss, n) of
@@ -82,16 +82,16 @@ fun prepString (e, st) =
 
                   | ECase (e,
                            [((PNone _, _),
-                             (EPrim (Prim.String "NULL"), _)),
+                             (EPrim (Prim.String (_, "NULL")), _)),
                             ((PSome (_, (PVar _, _)), _),
                              (EFfiApp (m, x, [((ERel 0, _), _)]), _))],
                            {disc = t, ...}) => prepString' ((EFfiApp (m, x, [(e, t)]), #2 e), ss, n)
 
                   | ECase (e,
                            [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
-                             (EPrim (Prim.String "TRUE"), _)),
+                             (EPrim (Prim.String (_, "TRUE")), _)),
                             ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
-                             (EPrim (Prim.String "FALSE"), _))],
+                             (EPrim (Prim.String (_, "FALSE")), _))],
                            _) => doOne Bool
 
                   | _ => NONE
@@ -268,14 +268,14 @@ fun prepExp (e as (_, loc), st) =
         if #supportsNextval (Settings.currentDbms ()) then
             let
                 val s = case seq of
-                            (EPrim (Prim.String s), loc) =>
-                            (EPrim (Prim.String ("SELECT NEXTVAL('" ^ s ^ "')")), loc)
+                            (EPrim (Prim.String (_, s)), loc) =>
+                            (EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('" ^ s ^ "')")), loc)
                           | _ =>
                             let
                                 val t = (TFfi ("Basis", "string"), loc)
-                                val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String "')"), loc), t)]), loc)
+                                val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String (Prim.Normal, "')")), loc), t)]), loc)
                             in
-                                (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String "SELECT NEXTVAL('"), loc), t), (s', t)]), loc)
+                                (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('")), loc), t), (s', t)]), loc)
                             end
             in
                 case prepString (s, st) of
diff --git a/src/prim.sig b/src/prim.sig
index 74147471..1da53d33 100644
--- a/src/prim.sig
+++ b/src/prim.sig
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -27,10 +27,12 @@
 
 signature PRIM = sig
 
+    datatype string_mode = Normal | Html
+
     datatype t =
              Int of Int64.int
            | Float of Real64.real
-           | String of string
+           | String of string_mode * string
            | Char of char
 
     val p_t : t Print.printer
diff --git a/src/prim.sml b/src/prim.sml
index 94801e7f..1de4fc7b 100644
--- a/src/prim.sml
+++ b/src/prim.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -27,10 +27,12 @@
 
 structure Prim :> PRIM = struct
 
+datatype string_mode = Normal | Html
+
 datatype t =
          Int of Int64.int
        | Float of Real64.real
-       | String of string
+       | String of string_mode * string
        | Char of char
 
 open Print.PD
@@ -40,7 +42,7 @@ fun p_t t =
     case t of
         Int n => string (Int64.toString n)
       | Float n => string (Real64.toString n)
-      | String s => box [string "\"", string (String.toString s), string "\""]
+      | String (_, s) => box [string "\"", string (String.toString s), string "\""]
       | Char ch => box [string "#\"", string (String.toString (String.str ch)), string "\""]
 
 fun int2s n =
@@ -61,7 +63,7 @@ fun toString t =
     case t of
         Int n => int2s' n
       | Float n => float2s n
-      | String s => s
+      | String (_, s) => s
       | Char ch => str ch
 
 fun pad (n, ch, s) =
@@ -86,14 +88,14 @@ fun p_t_GCC t =
     case t of
         Int n => string (int2s n)
       | Float n => string (float2s n)
-      | String s => box [string "\"", string (toCString s), string "\""]
+      | String (_, s) => box [string "\"", string (toCString s), string "\""]
       | Char ch => box [string "'", string (toCChar ch), string "'"]
 
 fun equal x =
     case x of
         (Int n1, Int n2) => n1 = n2
       | (Float n1, Float n2) => Real64.== (n1, n2)
-      | (String s1, String s2) => s1 = s2
+      | (String (_, s1), String (_, s2)) => s1 = s2
       | (Char ch1, Char ch2) => ch1 = ch2
 
       | _ => false
@@ -108,7 +110,7 @@ fun compare (p1, p2) =
       | (Float _, _) => LESS
       | (_, Float _) => GREATER 
 
-      | (String n1, String n2) => String.compare (n1, n2)
+      | (String (_, n1), String (_, n2)) => String.compare (n1, n2)
       | (String _, _) => LESS
       | (_, String _) => GREATER
 
diff --git a/src/shake.sml b/src/shake.sml
index 57ebec8e..051507d8 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -44,7 +44,7 @@ type free = {
 }
 
 val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan)
-val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan)
+val dummye = (EPrim (Prim.String (Prim.Normal, "")), ErrorMsg.dummySpan)
 
 fun tupleC cs = (CTuple cs, ErrorMsg.dummySpan)
 fun tupleE es = (ERecord (map (fn e => (dummyt, e, dummyt)) es), ErrorMsg.dummySpan)
diff --git a/src/sql.sml b/src/sql.sml
index c314eb3d..91e303c3 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -47,7 +47,7 @@ datatype chunk =
 
 fun chunkify e =
     case #1 e of
-        EPrim (Prim.String s) => [String s]
+        EPrim (Prim.String (_, s)) => [String s]
       | EStrcat (e1, e2) =>
         let
             val chs1 = chunkify e1
@@ -248,7 +248,7 @@ val prim =
                               (Option.map Prim.Int o Int64.fromString))
                        (opt (const "::int8"))) #1,
           wrap (follow (opt (const "E")) (follow string (opt (const "::text"))))
-               (Prim.String o #1 o #2)]
+               ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)]
 
 fun known' chs =
     case chs of
@@ -263,9 +263,9 @@ fun sqlify chs =
         else
             NONE
       | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
-                         (EPrim (Prim.String "TRUE"), _)),
+                         (EPrim (Prim.String (Prim.Normal, "TRUE")), _)),
                         ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
-                         (EPrim (Prim.String "FALSE"), _))], _), _) :: chs =>
+                         (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs =>
         SOME (e, chs)
                           
       | _ => NONE
diff --git a/src/urweb.grm b/src/urweb.grm
index 862debc5..edac345f 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -282,11 +282,11 @@ fun parseValue s pos =
         in
             (EApp ((EVar (["Basis"], "css_url", Infer), pos),
                    (EApp ((EVar (["Basis"], "bless", Infer), pos),
-                          (EPrim (Prim.String s), pos)), pos)), pos)
+                          (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)), pos)
         end
     else
         (EApp ((EVar (["Basis"], "atom", Infer), pos),
-               (EPrim (Prim.String s), pos)), pos)
+               (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)
 
 fun parseProperty s pos =
     let
@@ -294,11 +294,11 @@ fun parseProperty s pos =
     in
         if Substring.isEmpty after then
             (ErrorMsg.errorAt pos ("Invalid CSS property syntax: " ^ s);
-             (EPrim (Prim.String ""), pos))
+             (EPrim (Prim.String (Prim.Normal, "")), pos))
         else
             foldl (fn (value, e) => (EApp ((EApp ((EVar (["Basis"], "value", Infer), pos), e), pos), parseValue value pos), pos))
                 (EApp ((EVar (["Basis"], "property", Infer), pos),
-                       (EPrim (Prim.String (Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos)
+                       (EPrim (Prim.String (Prim.Normal, Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos)
                 (String.tokens Char.isSpace (Substring.string (Substring.slice (after, 1, NONE))))
     end
 
@@ -1152,8 +1152,8 @@ eapps  : eterm                          (eterm)
        | eapps BANG                     (EDisjointApp eapps, s (eappsleft, BANGright))
 
 eexp   : eapps                          (case #1 eapps of
-                                             EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String s), loc)) => parseClass s loc
-                                           | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String s), loc)) => parseStyle s loc
+                                             EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String (_, s)), loc)) => parseClass s loc
+                                           | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String (_, s)), loc)) => parseStyle s loc
                                            | _ => eapps)
        | FN eargs DARROW eexp           (let
                                              val loc = s (FNleft, eexpright)
@@ -1347,7 +1347,7 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
 
        | INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
        | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
-       | STRING                         (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
+       | STRING                         (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
        | CHAR                           (EPrim (Prim.Char CHAR), s (CHARleft, CHARright))
 
        | path DOT idents                (let
@@ -1396,7 +1396,7 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
                                              else
                                                  ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
                                              (EApp ((EVar (["Basis"], "cdata", Infer), loc),
-                                                    (EPrim (Prim.String ""), loc)),
+                                                    (EPrim (Prim.String (Prim.Html, "")), loc)),
                                               loc)
                                          end)
        | XML_BEGIN_END                  (let
@@ -1407,7 +1407,7 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
                                              else
                                                  ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
                                              (EApp ((EVar (["Basis"], "cdata", Infer), loc),
-                                                    (EPrim (Prim.String ""), loc)),
+                                                    (EPrim (Prim.String (Prim.Html, "")), loc)),
                                               loc)
                                          end)
 
@@ -1511,7 +1511,7 @@ pterm  : SYMBOL                         (PVar SYMBOL, s (SYMBOLleft, SYMBOLright
        | UNDER                          (PWild, s (UNDERleft, UNDERright))
        | INT                            (PPrim (Prim.Int INT), s (INTleft, INTright))
        | MINUS INT                      (PPrim (Prim.Int (~INT)), s (MINUSleft, INTright))
-       | STRING                         (PPrim (Prim.String STRING), s (STRINGleft, STRINGright))
+       | STRING                         (PPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
        | CHAR                           (PPrim (Prim.Char CHAR), s (CHARleft, CHARright))
        | LPAREN pat RPAREN              (pat)
        | LBRACE RBRACE                  (PRecord ([], false), s (LBRACEleft, RBRACEright))
@@ -1547,11 +1547,11 @@ xml    : xmlOne xml                     (let
 
 xmlOpt : xml                            (xml)
        |                                (EApp ((EVar (["Basis"], "cdata", Infer), dummy),
-                                               (EPrim (Prim.String ""), dummy)),
+                                               (EPrim (Prim.String (Prim.Html, "")), dummy)),
                                          dummy)
 
 xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)),
-                                               (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
+                                               (EPrim (Prim.String (Prim.Html, NOTAGS)), s (NOTAGSleft, NOTAGSright))),
                                          s (NOTAGSleft, NOTAGSright))
        | tag DIVIDE GT                  (let
                                              val pos = s (tagleft, GTright)
@@ -1568,7 +1568,7 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                      (EVar (["Basis"], "cdata", Infer), pos)
 
                                              val cdata = (EApp (cdata,
-                                                                (EPrim (Prim.String ""), pos)),
+                                                                (EPrim (Prim.String (Prim.Html, "")), pos)),
                                                           pos)
                                          in
                                              (EApp (#4 tag, cdata), pos)
@@ -1629,7 +1629,7 @@ tag    : tagHead attrs                  (let
                                              val e = (EVar (["Basis"], "tag", Infer), pos)
                                              val eo = case #1 attrs of
                                                           NONE => (EVar (["Basis"], "null", Infer), pos)
-                                                        | SOME (EPrim (Prim.String s), pos) => parseClass s pos
+                                                        | SOME (EPrim (Prim.String (_, s)), pos) => parseClass s pos
                                                         | SOME e => e
                                              val e = (EApp (e, eo), pos)
                                              val eo = case #2 attrs of
@@ -1639,7 +1639,7 @@ tag    : tagHead attrs                  (let
                                              val e = (EApp (e, eo), pos)
                                              val eo = case #3 attrs of
                                                           NONE => (EVar (["Basis"], "noStyle", Infer), pos)
-                                                        | SOME (EPrim (Prim.String s), pos) => parseStyle s pos
+                                                        | SOME (EPrim (Prim.String (_, s)), pos) => parseStyle s pos
                                                         | SOME e => e
                                              val e = (EApp (e, eo), pos)
                                              val eo = case #4 attrs of
@@ -1656,7 +1656,7 @@ tag    : tagHead attrs                  (let
                                                                     let
                                                                         val e = (EVar (["Basis"], "data_attr", Infer), pos)
                                                                         val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos)
-                                                                        val e = (EApp (e, (EPrim (Prim.String name), pos)), pos)
+                                                                        val e = (EApp (e, (EPrim (Prim.String (Prim.Normal, name)), pos)), pos)
                                                                     in
                                                                         (EApp (e, value), pos)
                                                                     end
@@ -1750,7 +1750,7 @@ attr   : SYMBOL EQ attrv                (case SYMBOL of
                 
 attrv  : INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
        | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
-       | STRING                         (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
+       | STRING                         (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
        | LBRACE eexp RBRACE             (eexp)
 
 query  : query1 obopt lopt ofopt        (let
@@ -2038,7 +2038,7 @@ sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True", In
                                                      s (INTleft, INTright)))
        | FLOAT                          (sql_inject (EPrim (Prim.Float FLOAT),
                                                      s (FLOATleft, FLOATright)))
-       | STRING                         (sql_inject (EPrim (Prim.String STRING),
+       | STRING                         (sql_inject (EPrim (Prim.String (Prim.Normal, STRING)),
                                                      s (STRINGleft, STRINGright)))
        | CURRENT_TIMESTAMP              (sql_nfunc ("current_timestamp",
                                                     s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))
-- 
cgit v1.2.3


From ee4ec02054d2ec9c07cb2d0e0350f0d0cfd253a9 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 1 Aug 2014 16:11:36 -0400
Subject: When unifying constructor-level unification variables, also unify
 their kinds

---
 src/elaborate.sml   | 42 +++++++++++++++++++++++-------------------
 tests/wackyunif.ur  |  2 ++
 tests/wackyunif.urp |  2 ++
 3 files changed, 27 insertions(+), 19 deletions(-)
 create mode 100644 tests/wackyunif.ur
 create mode 100644 tests/wackyunif.urp

diff --git a/src/elaborate.sml b/src/elaborate.sml
index 03e9d6e8..c55dec01 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1226,26 +1226,29 @@
              else
                  err (fn _ => TooLifty (loc1, loc2))
 
-           | (L'.CUnif (0, _, _, _, r as ref (L'.Unknown f)), _) =>
+           | (L'.CUnif (0, _, k1, _, r as ref (L'.Unknown f)), _) =>
+             (unifyKinds env k1 (kindof env c2All);
+              if occursCon r c2All then
+                  maybeIsRecord c2
+              else if f c2All then
+                  r := L'.Known c2All
+              else
+                  err CScope)
+           | (_, L'.CUnif (0, _, k2, _, r as ref (L'.Unknown f))) =>
+             (unifyKinds env (kindof env c1All) k2;
+              if occursCon r c1All then
+                  maybeIsRecord c1
+              else if f c1All then
+                  r := L'.Known c1All
+              else
+                  err CScope)
+
+           | (L'.CUnif (nl, _, k1, _, r as ref (L'.Unknown f)), _) =>
              if occursCon r c2All then
                  maybeIsRecord c2
-             else if f c2All then
-                 r := L'.Known c2All
              else
-                 err CScope
-           | (_, L'.CUnif (0, _, _, _, r as ref (L'.Unknown f))) =>
-             if occursCon r c1All then
-                 maybeIsRecord c1
-             else if f c1All then
-                 r := L'.Known c1All
-             else
-                 err CScope
-
-           | (L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f)), _) =>
-             if occursCon r c2All then
-                 maybeIsRecord c2
-             else
-                 (let
+                 (unifyKinds env k1 (kindof env c2All);
+                  let
                       val sq = squish nl c2All
                   in
                       if f sq then
@@ -1254,11 +1257,12 @@
                           err CScope
                   end
                   handle CantSquish => err (fn _ => TooDeep))
-           | (_, L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f))) =>
+           | (_, L'.CUnif (nl, _, k2, _, r as ref (L'.Unknown f))) =>
              if occursCon r c1All then
                  maybeIsRecord c1
              else
-                 (let
+                 (unifyKinds env (kindof env c1All) k2;
+                  let
                       val sq = squish nl c1All
                   in
                       if f sq then
diff --git a/tests/wackyunif.ur b/tests/wackyunif.ur
new file mode 100644
index 00000000..2a215e69
--- /dev/null
+++ b/tests/wackyunif.ur
@@ -0,0 +1,2 @@
+val concatX [ctx] [use] : _ -> _ ctx use _ =
+    List.foldl join <xml/>
diff --git a/tests/wackyunif.urp b/tests/wackyunif.urp
new file mode 100644
index 00000000..35791acf
--- /dev/null
+++ b/tests/wackyunif.urp
@@ -0,0 +1,2 @@
+$/list
+wackyunif
-- 
cgit v1.2.3


From ba4af1234ee438d5c5cb87ba624b03b69135ab93 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 6 Aug 2014 09:50:02 -0400
Subject: MonoReduce bug involving 'error'

---
 src/mono_reduce.sml | 2 +-
 tests/pb.ur         | 7 +++++++
 tests/pb.urs        | 1 +
 3 files changed, 9 insertions(+), 1 deletion(-)
 create mode 100644 tests/pb.ur
 create mode 100644 tests/pb.urs

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index f1a6758d..50553560 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -685,7 +685,7 @@ fun reduce (file : file) =
                                                           map (fn (p, (EAbs (_, _, _, e), _)) =>
                                                                   (p, swapExpVarsPat (0, patBinds p) e)
                                                                 | (p, (EError (e, (TFun (_, t), _)), loc)) =>
-                                                                  (p, (EError (e, t), loc))
+                                                                  (p, (EError (liftExpInExp (patBinds p) e, t), loc))
                                                                 | (p, e) =>
                                                                   (p, (EApp (liftExpInExp (patBinds p) e,
                                                                              (ERel (patBinds p), loc)), loc)))
diff --git a/tests/pb.ur b/tests/pb.ur
new file mode 100644
index 00000000..e6e5bd5c
--- /dev/null
+++ b/tests/pb.ur
@@ -0,0 +1,7 @@
+fun api_1 (pb:postBody) (nm:string) : transaction page =
+  return <xml>Processing the request</xml>
+
+fun api (pb:postBody) (v:int) (nm:string) : transaction page =
+  case v of
+      1 => api_1 pb nm
+    | _ => error <xml>Version {[v]} is not supported</xml>
diff --git a/tests/pb.urs b/tests/pb.urs
new file mode 100644
index 00000000..9def0871
--- /dev/null
+++ b/tests/pb.urs
@@ -0,0 +1 @@
+val api : postBody -> int -> string -> transaction page
-- 
cgit v1.2.3


From e17e39f02be8294f2fbb8f404b7af41138ab008d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 7 Aug 2014 09:17:52 -0400
Subject: New release

---
 CHANGELOG    | 10 ++++++++++
 configure.ac |  4 ++--
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index e8bf5071..b80c8d9f 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,13 @@
+========
+20140807
+========
+
+- New .urp directive: 'file'
+- Support for 'aria-*' attributes in HTML
+- Default value of 'jsFunc' for less-safe FFI
+- Client-side implementation of Basis function 'strsindex'
+- Bug fixes and improvements to type inference and documentation
+
 ========
 20140704
 ========
diff --git a/configure.ac b/configure.ac
index 8132bac4..ceb7005a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20140704])
-WORKING_VERSION=1
+AC_INIT([urweb], [20140807])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From fd4d68a8483496bcb52c87a2e0c37cc92e5e6774 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 7 Aug 2014 09:28:41 -0400
Subject: Return to working version mode

---
 configure.ac | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index ceb7005a..25698b7f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20140807])
-WORKING_VERSION=0
+WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From 1ef54c4722223a52f0b57bf0407cff39ebeb9f62 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Fri, 15 Aug 2014 07:11:31 +0000
Subject: Add tests/dbupload2.* files

tests/dbupload2.sh is a shell script which run the test scenario
On my machine the executable segfaults after curl request
---
 tests/dbupload2.sh  | 17 +++++++++++++++++
 tests/dbupload2.ur  | 29 +++++++++++++++++++++++++++++
 tests/dbupload2.urp |  7 +++++++
 tests/dbupload2.urs |  1 +
 4 files changed, 54 insertions(+)
 create mode 100755 tests/dbupload2.sh
 create mode 100644 tests/dbupload2.ur
 create mode 100644 tests/dbupload2.urp
 create mode 100644 tests/dbupload2.urs

diff --git a/tests/dbupload2.sh b/tests/dbupload2.sh
new file mode 100755
index 00000000..cecf1960
--- /dev/null
+++ b/tests/dbupload2.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+set -e
+
+cd `dirname $0`
+
+urweb -dbms sqlite dbupload2
+
+rm -rf dbupload2.db || true
+sqlite3 dbupload2.db < dbupload2.sql
+
+./dbupload2.exe -p 8083 &
+sleep 1
+
+touch /tmp/empty
+curl --verbose -F"operation=upload" -F"filename=@/tmp/empty" http://localhost:8083/Blabla/bla
+
diff --git a/tests/dbupload2.ur b/tests/dbupload2.ur
new file mode 100644
index 00000000..428f2460
--- /dev/null
+++ b/tests/dbupload2.ur
@@ -0,0 +1,29 @@
+table t : { Id : int, Blob : blob, MimeType : string }
+sequence s
+
+fun getImage id : transaction page =
+    r <- oneRow1 (SELECT t.Blob, t.MimeType
+                  FROM t
+                  WHERE t.Id = {[id]});
+    returnBlob r.Blob (blessMime r.MimeType)
+
+fun handle (r : {File:file, Param:string}) =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Blob, MimeType)
+         VALUES ({[id]}, {[fileData r.File]}, {[fileMimeType r.File]}));
+    debug ("Text is " ^ r.Param);
+    main ()
+
+and main () : transaction page =
+    x <- queryX1 (SELECT t.Id FROM t)
+                 (fn r => <xml><img src={url (getImage r.Id)}/>
+</xml>);
+    return <xml><body>
+      <form>
+      <upload{#File}/>
+      <textbox{#Param} value="text"/>
+      <submit action={handle}/>
+      </form>
+      <hr/>
+      {x}
+    </body></xml>
diff --git a/tests/dbupload2.urp b/tests/dbupload2.urp
new file mode 100644
index 00000000..bd550589
--- /dev/null
+++ b/tests/dbupload2.urp
@@ -0,0 +1,7 @@
+database dbname=dbupload2.db
+sql dbupload2.sql
+allow mime *
+rewrite all Dbupload2/*
+debug
+
+dbupload2
diff --git a/tests/dbupload2.urs b/tests/dbupload2.urs
new file mode 100644
index 00000000..80240dee
--- /dev/null
+++ b/tests/dbupload2.urs
@@ -0,0 +1 @@
+val main: {} -> transaction page
-- 
cgit v1.2.3


From 60fbd47e8c5695e3c418f96bab81cb0321359f30 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 15 Aug 2014 18:25:56 -0400
Subject: Don't use uw_malloc() or equivalent in generating error messages
 while parsing HTTP request

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

diff --git a/.hgignore b/.hgignore
index 9a411ff9..4139717b 100644
--- a/.hgignore
+++ b/.hgignore
@@ -66,6 +66,8 @@ install-sh
 ltmain.sh
 missing
 
+tests/*.db
+
 syntax: regexp
 
 ^Makefile$
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 1799d01e..43c73661 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1043,12 +1043,12 @@ int uw_set_file_input(uw_context ctx, const char *name, uw_Basis_file f) {
   int n = ctx->app->input_num(name);
 
   if (n < 0) {
-    uw_set_error(ctx, "Bad file input name %s", uw_Basis_htmlifyString(ctx, name));
+    uw_set_error(ctx, "Bad file input name");
     return -1;
   }
 
   if (n >= ctx->app->inputs_len) {
-    uw_set_error(ctx, "For file input name %s, index %d is out of range", uw_Basis_htmlifyString(ctx, name), n);
+    uw_set_error(ctx, "For file input name, index %d is out of range", n);
     return -1;
   }
 
-- 
cgit v1.2.3


From 4e6800f06759329f892ca8f40fcf50186b3785e1 Mon Sep 17 00:00:00 2001
From: Ziv Scully <ziv@mit.edu>
Date: Sun, 10 Aug 2014 13:40:53 -0400
Subject: Adds AJAX-oriented widget cpassword.

---
 lib/js/urweb.js  | 12 ++++++++++++
 lib/ur/basis.urs |  2 ++
 src/css.sml      |  3 ++-
 src/monoize.sml  | 29 ++++++++++++++++++++++++++---
 4 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 76a900f7..5cc49fec 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1050,6 +1050,18 @@ function inp(s, name) {
     return x;
 }
 
+function password(s, name) {
+    if (suspendScripts)
+        return;
+
+    var x = input(document.createElement("input"), s,
+                  function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "password", name);
+    x.value = s.data;
+    x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
+
+    return x;
+}
+
 function selectValue(x) {
     if (x.options.length == 0)
         return "";
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 8efed25b..39487aef 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1013,6 +1013,8 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
 
 val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
                           Ontext = transaction unit] ++ boxAttrs) []
+val cpassword : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
+                          Ontext = transaction unit] ++ boxAttrs) []
 val button : cformTag ([Value = string] ++ boxAttrs) []
 
 val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) []
diff --git a/src/css.sml b/src/css.sml
index 5db0c502..9e50686f 100644
--- a/src/css.sml
+++ b/src/css.sml
@@ -16,7 +16,7 @@
  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
@@ -101,6 +101,7 @@ val tags = [("span", inline),
             ("submit", replaced),
             ("label", inline),
             ("ctextbox", replaced),
+            ("cpassword", replaced),
             ("button", replaced),
             ("ccheckbox", replaced),
             ("cselect", replaced),
diff --git a/src/monoize.sml b/src/monoize.sml
index a1f97184..6073a21f 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3276,14 +3276,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                     (rest, SOME value)
                                                   | _ => (attrs, 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", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"]
+                val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"]
 
                 fun isSome (e, _) =
                     case e of
@@ -3736,6 +3736,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 				  fm)
                              end)
 
+                      | "cpassword" =>
+			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                             NONE =>
+                             let
+				 val (ts, fm) = tagStart "input"
+                             in
+				 ((L'.EStrcat (ts,
+                                               strH " type=\"password\" />"),
+                                   loc), fm)
+                             end
+                           | SOME (_, src, _) =>
+                             let
+				 val sc = strcat [str "password(exec(",
+						  (L'.EJavaScript (L'.Script, src), loc),
+						  str "))"]
+				 val sc = setAttrs sc
+                             in
+				 (strcat [str "<script type=\"text/javascript\">",
+					  sc,
+					  str "</script>"],
+				  fm)
+                             end)
+
                       | "ccheckbox" =>
 			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
                              NONE =>
@@ -4477,7 +4500,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
                             (L'.TFfi ("Basis", "int"), loc)
                         else
                             un
-                            
+
                 val e2 = (L'.EAbs ("$x", t, (L'.TFun (un, un), loc),
                                    (L'.EAbs ("$y", un, un,
                                              (L'.EApp (
-- 
cgit v1.2.3


From e230d565f1f0604eee2c964dab5374d07c24ed6d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 17 Aug 2014 13:07:56 -0400
Subject: New phase: Dbmodecheck

---
 include/urweb/urweb_cpp.h |  1 +
 src/c/urweb.c             |  9 +++--
 src/cjr.sml               |  3 +-
 src/cjr_print.sml         |  8 +++--
 src/cjrize.sml            | 10 +++---
 src/compiler.sig          |  1 +
 src/compiler.sml          |  9 ++++-
 src/dbmodecheck.sig       | 32 ++++++++++++++++++
 src/dbmodecheck.sml       | 86 +++++++++++++++++++++++++++++++++++++++++++++++
 src/mono.sml              |  9 +++--
 src/scriptcheck.sml       |  2 +-
 src/sources               |  3 ++
 12 files changed, 160 insertions(+), 13 deletions(-)
 create mode 100644 src/dbmodecheck.sig
 create mode 100644 src/dbmodecheck.sml

diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 72997a12..d83b2cbb 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -90,6 +90,7 @@ uw_Basis_string uw_Basis_maybe_onunload(struct uw_context *, uw_Basis_string);
 void uw_set_needs_push(struct uw_context *, int);
 void uw_set_needs_sig(struct uw_context *, int);
 void uw_set_could_write_db(struct uw_context *, int);
+void uw_set_at_most_one_query(struct uw_context *, int);
 
 char *uw_Basis_htmlifyInt(struct uw_context *, uw_Basis_int);
 char *uw_Basis_htmlifyFloat(struct uw_context *, uw_Basis_float);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 43c73661..d7bc05e3 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -441,7 +441,7 @@ struct uw_context {
 
   const char *script_header;
 
-  int needs_push, needs_sig, could_write_db;
+  int needs_push, needs_sig, could_write_db, at_most_one_query;
 
   size_t n_deltas, used_deltas;
   delta *deltas;
@@ -520,6 +520,7 @@ uw_context uw_init(int id, uw_loggers *lg) {
   ctx->needs_push = 0;
   ctx->needs_sig = 0;
   ctx->could_write_db = 1;
+  ctx->at_most_one_query = 0;
 
   ctx->source_count = 0;
 
@@ -786,7 +787,7 @@ failure_kind uw_begin(uw_context ctx, char *path) {
 }
 
 void uw_ensure_transaction(uw_context ctx) {
-  if (!ctx->transaction_started) {
+  if (!ctx->transaction_started && !ctx->at_most_one_query) {
     if (ctx->app->db_begin(ctx, ctx->could_write_db))
       uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN");
     ctx->transaction_started = 1;
@@ -1205,6 +1206,10 @@ void uw_set_could_write_db(uw_context ctx, int n) {
   ctx->could_write_db = n;
 }
 
+void uw_set_at_most_one_query(uw_context ctx, int n) {
+  ctx->at_most_one_query = n;
+}
+
 
 static void uw_buffer_check_ctx(uw_context ctx, const char *kind, uw_buffer *b, size_t extra, const char *desc) {
   if (b->back - b->front < extra) {
diff --git a/src/cjr.sml b/src/cjr.sml
index 8cbabdcc..3742a06f 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -129,10 +129,11 @@ datatype decl' =
 withtype decl = decl' located
 
 datatype sidedness = datatype Mono.sidedness
+datatype dbmode = datatype Mono.dbmode
 
 datatype effect = datatype Export.effect
 datatype export_kind = datatype Export.export_kind
 
-type file = decl list * (export_kind * string * int * typ list * typ * sidedness * bool) list
+type file = decl list * (export_kind * string * int * typ list * typ * sidedness * dbmode * bool) list
 
 end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index a4cc8c54..0867f001 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2634,7 +2634,7 @@ fun p_file env (ds, ps) =
                 end
               | _ => NONE
 
-        val fields = foldl (fn ((ek, _, _, ts, _, _, _), fields) =>
+        val fields = foldl (fn ((ek, _, _, ts, _, _, _, _), fields) =>
                                case ek of
                                    Action eff =>
                                    (case List.nth (ts, length ts - 2) of
@@ -2956,7 +2956,7 @@ fun p_file env (ds, ps) =
                       scripts (Settings.getScripts ())
             end
 
-        fun p_page (ek, s, n, ts, ran, side, tellSig) =
+        fun p_page (ek, s, n, ts, ran, side, dbmode, tellSig) =
             let
                 val (ts, defInputs, inputsVar, fields) =
                     case ek of
@@ -3106,6 +3106,10 @@ fun p_file env (ds, ps) =
                      string (if couldWriteDb ek then "1" else "0"),
                      string ");",
                      newline,
+                     string "uw_set_at_most_one_query(ctx, ",
+                     string (case dbmode of OneQuery => "1" | _ => "0"),
+                     string ");",
+                     newline,
                      string "uw_set_needs_push(ctx, ",
                      string (case side of
                                  ServerAndPullAndPush => "1"
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 6dc0299c..11174162 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -730,12 +730,14 @@ fun cjrize (ds, sideInfo) =
                                           end)
                                       ([], [], [], Sm.empty) ds
 
-        val sideInfo = foldl (fn ((n, mode), mp) => IM.insert (mp, n, mode)) IM.empty sideInfo
+        val sideInfo = foldl (fn ((n, mode, dbmode), mp) => IM.insert (mp, n, (mode, dbmode))) IM.empty sideInfo
 
         val ps = map (fn (ek, s, n, ts, t, _, b) =>
-                         (ek, s, n, ts, t,
-                          getOpt (IM.find (sideInfo, n), L'.ServerOnly),
-                          b)) ps
+                         let
+                             val (side, db) = getOpt (IM.find (sideInfo, n), (L'.ServerOnly, L'.AnyDb))
+                         in
+                             (ek, s, n, ts, t, side, db, b)
+                         end) ps
     in
         (List.revAppend (dsF, rev ds),
          ps)
diff --git a/src/compiler.sig b/src/compiler.sig
index fa131cf4..d74ec533 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -172,6 +172,7 @@ signature COMPILER = sig
     val toNamejs : (string, Mono.file) transform
     val toNamejs_untangle : (string, Mono.file) transform
     val toScriptcheck : (string, Mono.file) transform
+    val toDbmodecheck : (string, Mono.file) transform
     val toJscomp : (string, Mono.file) transform
     val toMono_opt3 : (string, Mono.file) transform
     val toFuse : (string, Mono.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index 2190684a..716cc3d3 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1401,12 +1401,19 @@ val scriptcheck = {
 
 val toScriptcheck = transform scriptcheck "scriptcheck" o toNamejs_untangle
 
+val dbmodecheck = {
+    func = DbModeCheck.classify,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toDbmodecheck = transform dbmodecheck "dbmodecheck" o toScriptcheck
+
 val jscomp = {
     func = JsComp.process,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toJscomp = transform jscomp "jscomp" o toScriptcheck
+val toJscomp = transform jscomp "jscomp" o toDbmodecheck
 
 val toMono_opt3 = transform mono_opt "mono_opt3" o toJscomp
 
diff --git a/src/dbmodecheck.sig b/src/dbmodecheck.sig
new file mode 100644
index 00000000..4d4873c4
--- /dev/null
+++ b/src/dbmodecheck.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature DB_MODE_CHECK = sig
+
+    val classify : Mono.file -> Mono.file
+
+end
diff --git a/src/dbmodecheck.sml b/src/dbmodecheck.sml
new file mode 100644
index 00000000..eb416cea
--- /dev/null
+++ b/src/dbmodecheck.sml
@@ -0,0 +1,86 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure DbModeCheck :> DB_MODE_CHECK = struct
+
+open Mono
+
+structure IM = IntBinaryMap
+
+fun classify (ds, ps) =
+    let
+        fun mergeModes (m1, m2) =
+            case (m1, m2) of
+                (NoDb, _) => m2
+              | (_, NoDb) => m1
+              | _ => AnyDb
+
+        fun modeOf modes =
+            MonoUtil.Exp.fold {typ = fn (_, dbm) => dbm,
+                               exp = fn (EQuery _, dbm) => mergeModes (OneQuery, dbm)
+                                      | (EDml _, _) => AnyDb
+                                      | (ENextval _, _) => AnyDb
+                                      | (ESetval _, _) => AnyDb
+                                      | (ENamed n, dbm) =>
+                                        (case IM.find (modes, n) of
+                                             NONE => dbm
+                                           | SOME dbm' => mergeModes (dbm, dbm'))
+                                      | (_, dbm) => dbm} NoDb
+
+        fun decl ((d, _), modes) =
+            case d of
+                DVal (x, n, _, e, _) => IM.insert (modes, n, modeOf modes e)
+              | DValRec xes =>
+                let
+                    val mode = foldl (fn ((_, _, _, e, _), mode) =>
+                                         let
+                                             val mode' = modeOf modes e
+                                         in
+                                             case mode' of
+                                                 NoDb => mode
+                                               | _ => AnyDb
+                                         end) NoDb xes
+                in
+                    foldl (fn ((_, n, _, _, _), modes) => IM.insert (modes, n, mode)) modes xes
+                end
+              | _ => modes
+
+        val modes = foldl decl IM.empty ds
+
+        val (ps, modes) = ListUtil.foldlMap (fn ((n, side, _), modes) =>
+                                                case IM.find (modes, n) of
+                                                    NONE => ((n, side, AnyDb), modes)
+                                                  | SOME mode => ((n, side, mode), #1 (IM.remove (modes, n))))
+                                            modes ps
+
+        val ps = IM.foldli (fn (n, mode, ps) => (n, ServerOnly, mode) :: ps) ps modes
+    in
+        (ds, ps)
+    end
+
+end
+
diff --git a/src/mono.sml b/src/mono.sml
index 78740d70..1e402e57 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, 2013, Adam Chlipala
+(* Copyright (c) 2008-2010, 2013-2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -162,6 +162,11 @@ datatype sidedness =
        | ServerAndPull
        | ServerAndPullAndPush
 
-type file = decl list * (int * sidedness) list
+datatype dbmode =
+         NoDb
+       | OneQuery
+       | AnyDb
+
+type file = decl list * (int * sidedness * dbmode) list
 
 end
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index e5db476a..4bc2a4cf 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -98,7 +98,7 @@ fun classify (ds, ps) =
                              else if IS.member (pull_ids, n) then
                                  ServerAndPull
                              else
-                                 ServerOnly)) (IS.listItems all_ids)
+                                 ServerOnly, AnyDb)) (IS.listItems all_ids)
     in
         (ds, ps)
     end
diff --git a/src/sources b/src/sources
index f75803a3..a5235357 100644
--- a/src/sources
+++ b/src/sources
@@ -223,6 +223,9 @@ $(SRC)/cjrize.sml
 $(SRC)/scriptcheck.sig
 $(SRC)/scriptcheck.sml
 
+$(SRC)/dbmodecheck.sig
+$(SRC)/dbmodecheck.sml
+
 $(SRC)/prepare.sig
 $(SRC)/prepare.sml
 
-- 
cgit v1.2.3


From ae2184ba9f564d2df96edd042a8dc6318f1ba299 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Sun, 17 Aug 2014 18:28:37 +0000
Subject: Allow Body tags inside cformTags

This is required by Bootstrap. For example, see
  http://getbootstrap.com/components/#alerts-dismissible
---
 lib/ur/basis.urs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 39487aef..9d58ee66 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1008,8 +1008,8 @@ val label : bodyTag ([For = id, Accesskey = string] ++ tableAttrs)
 
 con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
                   ctx ::: {Unit}
-                  -> [[Body] ~ ctx] =>
-                        unit -> tag attrs ([Body] ++ ctx) inner [] []
+                  -> [[Body] ~ ctx] => [[Body] ~ inner] =>
+                        unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] []
 
 val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
                           Ontext = transaction unit] ++ boxAttrs) []
-- 
cgit v1.2.3


From c89ba45eeb74aea74999276431f33174f60f4c0c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 17 Aug 2014 15:56:43 -0400
Subject: A new test for <button>

---
 tests/button.ur | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 tests/button.ur

diff --git a/tests/button.ur b/tests/button.ur
new file mode 100644
index 00000000..febcb0c9
--- /dev/null
+++ b/tests/button.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn _ => alert "AHOY"}><b>CLICK IT</b></button>
+</body></xml>
+
-- 
cgit v1.2.3


From 2bd5faedfe7464c9f4cc6bd36084d487c7c86b2a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 19 Aug 2014 11:08:25 -0400
Subject: New release

---
 CHANGELOG    | 7 +++++++
 configure.ac | 4 ++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index b80c8d9f..e56e24db 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,10 @@
+========
+20140819
+========
+
+- Improvements to HTML model
+- Bug fixes and optimization improvements
+
 ========
 20140807
 ========
diff --git a/configure.ac b/configure.ac
index 25698b7f..e0f795e1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20140807])
-WORKING_VERSION=1
+AC_INIT([urweb], [20140819])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From 277913f2ae39e159b1a639fe1d869fd00ce1a2c7 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 19 Aug 2014 11:17:39 -0400
Subject: <cselect> and <coption> type fixes (grandfathered into release)

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

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 9d58ee66..30271ce9 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1019,9 +1019,8 @@ val button : cformTag ([Value = string] ++ boxAttrs) []
 
 val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) []
 
-con cselect = [Cselect]
-val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) cselect
-val coption : unit -> tag [Value = string, Selected = bool] cselect [] [] []
+val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect]
+val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] []
 
 val ctextarea : cformTag ([Value = string, Rows = int, Cols = int, Source = source string, Onchange = transaction unit,
                            Ontext = transaction unit] ++ boxAttrs) []
-- 
cgit v1.2.3


From 9515ba96f8f48b17888267c15b3181893cca6be3 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 19 Aug 2014 11:23:26 -0400
Subject: Return to working version mode

---
 configure.ac | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index e0f795e1..074c26cd 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20140819])
-WORKING_VERSION=0
+WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From cb0fdb4d2b0682d67fe57dc755b574d1867216b5 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Mon, 7 Jul 2014 10:05:04 +0400
Subject: Add 'role' data attribute.

Note, that 'role' attribute is a part of reach ARIA API described here:
http://www.w3.org/TR/wai-aria/

Among 'role', it defines lots of aria-* attributes
---
 lib/ur/basis.urs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 30271ce9..5d0a0c8a 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -848,7 +848,7 @@ con scrollEvents = [Onscroll = transaction unit]
 con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents
 con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
 
-con boxAttrs = [Data = data_attr, Id = id, Title = string] ++ boxEvents
+con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string] ++ boxEvents
 con tableAttrs = [Data = data_attr, Id = id, Title = string] ++ tableEvents
 
 val span : bodyTag boxAttrs
-- 
cgit v1.2.3


From cbe0e1aeceefc7db712230a070ddcf757cfe1981 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Sat, 23 Aug 2014 11:59:34 +0000
Subject: Check realloc's return code to prevent segfault on out of memoty
 condition

---
 src/c/request.c | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/c/request.c b/src/c/request.c
index f212655f..9dc6aa59 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -444,8 +444,12 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
       int len = strlen(inputs);
 
       if (len+1 > rc->queryString_size) {
-        rc->queryString_size = len+1;
         rc->queryString = realloc(rc->queryString, len+1);
+        if(rc->queryString == NULL) {
+          log_error(logger_data, "queryString is too long (not enough memory)\n");
+          return FAILED;
+        }
+        rc->queryString_size = len+1;
       }
       strcpy(rc->queryString, inputs);
 
@@ -480,8 +484,12 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
       on_success(ctx);
 
       if (path_len + 1 > rc->path_copy_size) {
+        rc->path_copy = realloc(rc->path_copy, path_len + 1);
+        if(rc->path_copy == NULL) {
+          log_error(logger_data, "Path is too long (not enough memory)\n");
+          return FAILED;
+        }
         rc->path_copy_size = path_len + 1;
-        rc->path_copy = realloc(rc->path_copy, rc->path_copy_size);
       }
       strcpy(rc->path_copy, path);
 
-- 
cgit v1.2.3


From 0f24f4667d4571834c552d9a6ca3dbe180296bb0 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 24 Aug 2014 11:43:49 -0400
Subject: Extend ScriptCheck to take RPCs into account

---
 src/scriptcheck.sml  | 101 ++++++++++++++++++++++++++++++++++++++++++++-------
 tests/DynChannel.ur  |  29 +++++++++++++++
 tests/DynChannel.urp |   6 +++
 tests/rpchan.ur      |  18 +++++++++
 tests/rpchan.urs     |   1 +
 5 files changed, 142 insertions(+), 13 deletions(-)
 create mode 100644 tests/DynChannel.ur
 create mode 100644 tests/DynChannel.urp
 create mode 100644 tests/rpchan.ur
 create mode 100644 tests/rpchan.urs

diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index 4bc2a4cf..0d30ebcb 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009, Adam Chlipala
+(* Copyright (c) 2009, 2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -29,6 +29,10 @@ structure ScriptCheck :> SCRIPT_CHECK = struct
 
 open Mono
 
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
 structure SS = BinarySetFn(struct
                            type ord_key = string
                            val compare = String.compare
@@ -39,37 +43,108 @@ val pushBasis = SS.addList (SS.empty,
                             ["new_channel",
                              "self"])
 
+datatype rpcmap =
+         Rpc of int (* ID of function definition *)
+       | Module of rpcmap SM.map
+
+fun lookup (r : rpcmap, k : string) =
+    let
+        fun lookup' (r, ks) =
+            case r of
+                Rpc x => SOME x
+              | Module m =>
+                case ks of
+                    [] => NONE
+                  | k :: ks' =>
+                    case SM.find (m, k) of
+                        NONE => NONE
+                      | SOME r' => lookup' (r', ks')
+    in
+        lookup' (r, String.tokens (fn ch => ch = #"/") k)
+    end
+
+fun insert (r : rpcmap, k : string, v) =
+    let
+        fun insert' (r, ks) =
+            case r of
+                Rpc _ => Rpc v
+              | Module m =>
+                case ks of
+                    [] => Rpc v
+                  | k :: ks' =>
+                    let
+                        val r' = case SM.find (m, k) of
+                                     NONE => Module SM.empty
+                                   | SOME r' => r'
+                    in
+                        Module (SM.insert (m, k, insert' (r', ks')))
+                    end
+    in
+        insert' (r, String.tokens (fn ch => ch = #"/") k)
+    end
+
+fun dump (r : rpcmap) =
+    case r of
+        Rpc _ => print "ROOT\n"
+      | Module m => (print "<Module>\n";
+                     SM.appi (fn (k, r') => (print (k ^ ":\n");
+                                             dump r')) m;
+                     print "</Module>\n")
+
 fun classify (ds, ps) =
     let
         val proto = Settings.currentProtocol ()
 
         fun inString {needle, haystack} = String.isSubstring needle haystack
 
-        fun hasClient {basis, funcs, push} =
+        fun hasClient {basis, rpcs, funcs, push} =
             MonoUtil.Exp.exists {typ = fn _ => false,
                                  exp = fn ERecv _ => push
                                         | EFfiApp ("Basis", x, _) => SS.member (basis, x) 
                                         | EJavaScript _ => not push
                                         | ENamed n => IS.member (funcs, n)
+                                        | EServerCall (e, _, _, _) =>
+                                          let
+                                              fun head (e : exp) =
+                                                  case #1 e of
+                                                      EStrcat (e1, _) => head e1
+                                                    | EPrim (Prim.String (_, s)) => SOME s
+                                                    | _ => NONE
+                                          in
+                                              case head e of
+                                                  NONE => true
+                                                | SOME fcall =>
+                                                  case lookup (rpcs, fcall) of
+                                                      NONE => true
+                                                    | SOME n => IS.member (funcs, n)
+                                          end
                                         | _ => false}
 
+        fun decl ((d, _), rpcs) =
+            case d of
+                DExport (Mono.Rpc _, fcall, n, _, _, _) =>
+                insert (rpcs, fcall, n)
+              | _ => rpcs
+
+        val rpcs = foldl decl (Module SM.empty) ds
+
         fun decl ((d, _), (pull_ids, push_ids)) =
             let
-                val hasClientPull = hasClient {basis = SS.empty, funcs = pull_ids, push = false}
-                val hasClientPush = hasClient {basis = pushBasis, funcs = push_ids, push = true}
+                val hasClientPull = hasClient {basis = SS.empty, rpcs = rpcs, funcs = pull_ids, push = false}
+                val hasClientPush = hasClient {basis = pushBasis, rpcs = rpcs, funcs = push_ids, push = true}
             in
                 case d of
                     DVal (_, n, _, e, _) => (if hasClientPull e then
-                                             IS.add (pull_ids, n)
-                                          else
-                                              pull_ids,
-                                          if hasClientPush e then
-                                              IS.add (push_ids, n)
-                                          else
-                                              push_ids)
+                                                 IS.add (pull_ids, n)
+                                             else
+                                                 pull_ids,
+                                             if hasClientPush e then
+                                                 IS.add (push_ids, n)
+                                             else
+                                                 push_ids)
                   | DValRec xes => (if List.exists (fn (_, _, _, e, _) => hasClientPull e) xes then
-                                       foldl (fn ((_, n, _, _, _), pull_ids) => IS.add (pull_ids, n))
-                                             pull_ids xes
+                                        foldl (fn ((_, n, _, _, _), pull_ids) => IS.add (pull_ids, n))
+                                              pull_ids xes
                                     else
                                         pull_ids,
                                     if List.exists (fn (_, _, _, e, _) => hasClientPush e) xes then
diff --git a/tests/DynChannel.ur b/tests/DynChannel.ur
new file mode 100644
index 00000000..d3688781
--- /dev/null
+++ b/tests/DynChannel.ur
@@ -0,0 +1,29 @@
+table channels : {Id : int, Channel:channel xbody}
+
+fun dosend (s:string) : transaction unit =
+  c <- oneRow1 (SELECT * FROM channels);
+  debug ("Sending " ^ s ^ " through the channel...");
+  send c.Channel <xml>{[s]}</xml>
+
+fun mkchannel {} : transaction xbody =
+  c <- channel;
+  s <- source <xml/>;
+  dml( DELETE FROM channels WHERE Id >= 0);
+  dml( INSERT INTO channels(Id, Channel) VALUES(0, {[c]}) );
+  return <xml>
+    <button value="Send" onclick={fn _ => rpc(dosend "blabla")}/>
+    <active code={spawn(x <- recv c; alert ("Got something from the channel"); set s x); return <xml/>}/>
+    <dyn signal={signal s}/>
+  </xml>
+
+fun main {} : transaction page =
+  s <- source <xml/>;
+  return <xml>
+    <head/>
+    <body>
+      <button value="Register" onclick={fn _ =>
+        x <- rpc(mkchannel {}); set s x
+      }/>
+      <dyn signal={signal s}/>
+    </body>
+  </xml>
diff --git a/tests/DynChannel.urp b/tests/DynChannel.urp
new file mode 100644
index 00000000..08d6d1a5
--- /dev/null
+++ b/tests/DynChannel.urp
@@ -0,0 +1,6 @@
+database dbname=DynChannel.db
+sql DynChannel.sql
+debug
+
+$/list
+DynChannel
diff --git a/tests/rpchan.ur b/tests/rpchan.ur
new file mode 100644
index 00000000..08308d90
--- /dev/null
+++ b/tests/rpchan.ur
@@ -0,0 +1,18 @@
+fun remote () =
+    ch <- channel;
+    send ch "Hello World!";
+    return ch
+
+fun remoter () =
+    ch <- channel;
+    send ch "Hello World!";
+    return <xml><active code={spawn (s <- recv ch; alert s); return <xml/>}/></xml>
+
+fun main () =
+    x <- source <xml/>;
+    return <xml><body>
+      <button onclick={fn _ => ch <- rpc (remote ()); s <- recv ch; alert s}>TEST</button>
+      <button onclick={fn _ => y <- rpc (remoter ()); set x y}>TESTER</button>
+      <hr/>
+      <dyn signal={signal x}/>
+    </body></xml>
diff --git a/tests/rpchan.urs b/tests/rpchan.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/rpchan.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
-- 
cgit v1.2.3


From 4e4c43ff335cd6c2f1ec6bf359f69e9b09047572 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 30 Aug 2014 08:28:59 -0400
Subject: New release

---
 CHANGELOG    | 7 +++++++
 configure.ac | 4 ++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index e56e24db..979f4d87 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,10 @@
+========
+20140830
+========
+
+- New HTML attribute: 'role'
+- Bug fixes
+
 ========
 20140819
 ========
diff --git a/configure.ac b/configure.ac
index 074c26cd..85ce1da5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20140819])
-WORKING_VERSION=1
+AC_INIT([urweb], [20140830])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From 4fe4c6868a10db99ddadf4cd60576178df29c8cd Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 30 Aug 2014 08:48:41 -0400
Subject: Return to working version mode

---
 configure.ac | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 85ce1da5..2ff25580 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20140830])
-WORKING_VERSION=0
+WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3


From a894904947777bbc797a69b1d55ca4008375acaf Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 4 Sep 2014 08:40:14 -0400
Subject: In computing command lines, put filenames inside of quotes, to
 support spaces and other funky characters nicely

---
 src/compiler.sml | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/compiler.sml b/src/compiler.sml
index 716cc3d3..b46643ff 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, Adam Chlipala
+(* Copyright (c) 2008-2012, 2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -1483,7 +1483,10 @@ val sqlify = {
 
 val toSqlify = transform sqlify "sqlify" o toMono_opt2
 
-val escapeFilename = String.translate (fn #" " => "\\ " | #"\"" => "\\\"" | #"'" => "\\'" | ch => str ch)
+fun escapeFilename s =
+    "\""
+    ^ String.translate (fn #"\"" => "\\\"" | #"\\" => "\\\\" | ch => str ch) s
+    ^ "\""
 
 val beforeC = ref (fn () => ())
 
-- 
cgit v1.2.3


From 1bbc50639256f0a04b1866ad23a3945c17130068 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Sun, 24 Aug 2014 11:56:41 +0400
Subject: Check realloc's return code to prevent segfault on out of memory
 condition (Part 2)

---
 src/c/request.c | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/c/request.c b/src/c/request.c
index 9dc6aa59..d621aea7 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -444,11 +444,12 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
       int len = strlen(inputs);
 
       if (len+1 > rc->queryString_size) {
-        rc->queryString = realloc(rc->queryString, len+1);
-        if(rc->queryString == NULL) {
+        char *qs = realloc(rc->queryString, len+1); 
+        if(qs == NULL) {
           log_error(logger_data, "queryString is too long (not enough memory)\n");
           return FAILED;
         }
+        rc->queryString = qs;
         rc->queryString_size = len+1;
       }
       strcpy(rc->queryString, inputs);
@@ -484,11 +485,12 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
       on_success(ctx);
 
       if (path_len + 1 > rc->path_copy_size) {
-        rc->path_copy = realloc(rc->path_copy, path_len + 1);
-        if(rc->path_copy == NULL) {
+        char *pc = realloc(rc->path_copy, path_len + 1);
+        if(pc == NULL) {
           log_error(logger_data, "Path is too long (not enough memory)\n");
           return FAILED;
         }
+        rc->path_copy = pc;
         rc->path_copy_size = path_len + 1;
       }
       strcpy(rc->path_copy, path);
-- 
cgit v1.2.3


From c833454d70e5ae0436ed495f886209f95e07329e Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Tue, 2 Sep 2014 17:36:14 +0000
Subject: Replace common "if(!quiet) printf(...)" pattern with a macro

---
 src/c/http.c | 30 ++++++++++++------------------
 1 file changed, 12 insertions(+), 18 deletions(-)

diff --git a/src/c/http.c b/src/c/http.c
index 32dd1dd1..2e419f05 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -23,6 +23,9 @@ extern uw_app uw_application;
 int uw_backlog = SOMAXCONN;
 static int keepalive = 0, quiet = 0;
 
+#define qfprintf(f, fmt, args...) do { if(!quiet) fprintf(f, fmt, ##args); } while(0)
+#define qprintf(fmt, args...) do { if(!quiet) printf(fmt, ##args); } while(0)
+
 static char *get_header(void *data, const char *h) {
   char *s = data;
   int len = strlen(h);
@@ -86,8 +89,7 @@ static void *worker(void *data) {
       sock = uw_dequeue();
     }
 
-    if (!quiet)
-      printf("Handling connection with thread #%d.\n", me);
+    qprintf("Handling connection with thread #%d.\n", me);
 
     while (1) {
       int r;
@@ -107,16 +109,14 @@ static void *worker(void *data) {
         r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
         if (r < 0) {
-          if (!quiet)
-            fprintf(stderr, "Recv failed\n");
+          qfprintf(stderr, "Recv failed while receiving header\n");
           close(sock);
           sock = 0;
           break;
         }
 
         if (r == 0) {
-          if (!quiet)
-            printf("Connection closed.\n");
+          qprintf("Connection closed.\n");
           close(sock);
           sock = 0;
           break;
@@ -159,16 +159,14 @@ static void *worker(void *data) {
             r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
             if (r < 0) {
-              if (!quiet)
-                fprintf(stderr, "Recv failed\n");
+              qfprintf(stderr, "Recv failed\n");
               close(sock);
               sock = 0;
               goto done;
             }
 
             if (r == 0) {
-              if (!quiet)
-                fprintf(stderr, "Connection closed.\n");
+              qfprintf(stderr, "Connection closed.\n");
               close(sock);
               sock = 0;
               goto done;
@@ -236,8 +234,7 @@ static void *worker(void *data) {
         uw_set_headers(ctx, get_header, headers);
         uw_set_env(ctx, get_env, NULL);
 
-        if (!quiet)
-          printf("Serving URI %s....\n", path);
+        qprintf("Serving URI %s....\n", path);
         rr = uw_request(rc, ctx, method, path, query_string, body, back - body,
                         on_success, on_failure,
                         NULL, log_error, log_debug,
@@ -405,8 +402,7 @@ int main(int argc, char *argv[]) {
 
   sin_size = sizeof their_addr;
 
-  if (!quiet)
-    printf("Listening on port %d....\n", uw_port);
+  qprintf("Listening on port %d....\n", uw_port);
 
   {
     pthread_t thread;
@@ -434,11 +430,9 @@ int main(int argc, char *argv[]) {
     int new_fd = accept(sockfd, (struct sockaddr *)&their_addr, &sin_size);
 
     if (new_fd < 0) {
-      if (!quiet)
-        fprintf(stderr, "Socket accept failed\n");
+      qfprintf(stderr, "Socket accept failed\n");
     } else {
-      if (!quiet)
-        printf("Accepted connection.\n");
+      qprintf("Accepted connection.\n");
 
       if (keepalive) {
         int flag = 1; 
-- 
cgit v1.2.3


From af2946386863bcb273aa2677a3d6e235d1660b16 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Tue, 2 Sep 2014 17:37:22 +0000
Subject: Check realloc's return code to prevent segfault on out of memory
 condition (Part 3)

---
 src/c/http.c | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

diff --git a/src/c/http.c b/src/c/http.c
index 2e419f05..2a8b7e94 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -97,8 +97,15 @@ static void *worker(void *data) {
 
       if (back - buf == buf_size - 1) {
         char *new_buf;
-        buf_size *= 2;
-        new_buf = realloc(buf, buf_size);
+        size_t new_buf_size = buf_size*2;
+        new_buf = realloc(buf, new_buf_size);
+        if(!new_buf) {
+          qfprintf(stderr, "Realloc failed while receiving header\n");
+          close(sock);
+          sock = 0;
+          break;
+        }
+        buf_size = new_buf_size;
         back = new_buf + (back - buf);
         buf = new_buf;
       }
@@ -146,9 +153,16 @@ static void *worker(void *data) {
           while (back - body < clen) {
             if (back - buf == buf_size - 1) {
               char *new_buf;
-              buf_size *= 2;
-              new_buf = realloc(buf, buf_size);
-
+              size_t new_buf_size = buf_size * 2;
+              new_buf = realloc(buf, new_buf_size);
+              if(!new_buf) {
+                qfprintf(stderr, "Realloc failed while receiving content\n");
+                close(sock);
+                sock = 0;
+                goto done;
+              }
+
+              buf_size = new_buf_size;
               back = new_buf + (back - buf);
               body = new_buf + (body - buf);
               s = new_buf + (s - buf);
-- 
cgit v1.2.3


From 5d2d4930568267b0e205ece3d4908cdc7ff715a1 Mon Sep 17 00:00:00 2001
From: Sergey Mironov <grrwlf@gmail.com>
Date: Tue, 2 Sep 2014 17:42:10 +0000
Subject: Introduce recv timeout controlled by '-T' option in http.c

This should prevent a DDoS attack where attacker and keeps the connection open
but send no data.
---
 src/c/http.c | 29 +++++++++++++++++++++++++----
 1 file changed, 25 insertions(+), 4 deletions(-)

diff --git a/src/c/http.c b/src/c/http.c
index 2a8b7e94..9651a216 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -116,7 +116,7 @@ static void *worker(void *data) {
         r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
         if (r < 0) {
-          qfprintf(stderr, "Recv failed while receiving header\n");
+          qfprintf(stderr, "Recv failed while receiving header, retcode %d errno %m\n", r);
           close(sock);
           sock = 0;
           break;
@@ -173,7 +173,7 @@ static void *worker(void *data) {
             r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
             if (r < 0) {
-              qfprintf(stderr, "Recv failed\n");
+              qfprintf(stderr, "Recv failed while receiving content, retcode %d errno %m\n", r);
               close(sock);
               sock = 0;
               goto done;
@@ -312,7 +312,7 @@ static void *worker(void *data) {
 }
 
 static void help(char *cmd) {
-  printf("Usage: %s [-p <port>] [-a <IP address>] [-t <thread count>] [-k] [-q]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\n", cmd);
+  printf("Usage: %s [-p <port>] [-a <IP address>] [-t <thread count>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe -T option sets socket recv timeout (0 disables timeout, default is 5 sec)", cmd);
 }
 
 static void sigint(int signum) {
@@ -327,6 +327,7 @@ int main(int argc, char *argv[]) {
   struct sockaddr_in their_addr; // connector's address information
   socklen_t sin_size;
   int yes = 1, uw_port = 8080, nthreads = 1, i, *names, opt;
+  int recv_timeout_sec = 5;
  
   signal(SIGINT, sigint);
   signal(SIGPIPE, SIG_IGN); 
@@ -334,7 +335,7 @@ int main(int argc, char *argv[]) {
   my_addr.sin_addr.s_addr = INADDR_ANY; // auto-fill with my IP
   memset(my_addr.sin_zero, '\0', sizeof my_addr.sin_zero);
 
-  while ((opt = getopt(argc, argv, "hp:a:t:kq")) != -1) {
+  while ((opt = getopt(argc, argv, "hp:a:t:kqT:")) != -1) {
     switch (opt) {
     case '?':
       fprintf(stderr, "Unknown command-line option\n");
@@ -375,6 +376,15 @@ int main(int argc, char *argv[]) {
       keepalive = 1;
       break;
 
+    case 'T':
+      recv_timeout_sec = atoi(optarg);
+      if (recv_timeout_sec < 0) {
+        fprintf(stderr, "Invalid recv timeout\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
     case 'q':
       quiet = 1;
       break;
@@ -453,6 +463,17 @@ int main(int argc, char *argv[]) {
         setsockopt(new_fd, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
       }
 
+      if(recv_timeout_sec>0) {
+        int ret;
+        struct timeval tv;
+        memset(&tv, 0, sizeof(struct timeval));
+        tv.tv_sec = recv_timeout_sec;
+        ret = setsockopt(new_fd, SOL_SOCKET, SO_RCVTIMEO, (char *)&tv, sizeof(struct timeval));
+        if(ret != 0) {
+          qfprintf(stderr, "Timeout setting failed, errcode %d errno '%m'\n", ret);
+        }
+      }
+
       uw_enqueue(new_fd);
     }
   }
-- 
cgit v1.2.3