From 11c4df67ebb9051d0c3cfa6f785b0bf08c5f59fb Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 13 Feb 2016 10:05:36 -0500
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 351d1129..1afbfc56 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20160213])
-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 0ef3c4d155a9ce8cceb225607e97c927fdfe6b1a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 14 Feb 2016 21:10:46 -0500
Subject: Fix handling of returnBlob headers for FastCGI, etc.

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

diff --git a/src/c/urweb.c b/src/c/urweb.c
index c057688c..a9a169b8 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3915,9 +3915,18 @@ static char *old_headers(uw_context ctx) {
   if (uw_buffer_used(&ctx->outHeaders) == 0)
     return NULL;
   else {
-    char *s = strchr(ctx->outHeaders.start, '\n');
+    char *s;
+    int is_good;
+
+    if (strncasecmp(ctx->outHeaders.start, "Content-type: ", 14)) {
+      s = strchr(ctx->outHeaders.start, '\n');
+      is_good = strncasecmp(s+1, "Content-type: ", 14);
+    } else {
+      s = ctx->outHeaders.start;
+      is_good = 1;
+    }
 
-    if (s == NULL || strncasecmp(s+1, "Content-type: ", 14))
+    if (!is_good)
       return NULL;
     else {
       s = strchr(s+15, '\n');
-- 
cgit v1.2.3


From 5705d3b510277f033b8a0317b3fe520b0e5cc60a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Wed, 17 Feb 2016 12:12:12 -0500
Subject: Allow backslash-r in string literals

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

diff --git a/src/urweb.lex b/src/urweb.lex
index ca45eb6d..368b9f1b 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -224,6 +224,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 <STRING,CHAR> "\\\""  => (str := #"\"" :: !str; continue());
 <STRING,CHAR> "\\'"   => (str := #"'" :: !str; continue());
 <STRING,CHAR> "\\n"   => (str := #"\n" :: !str; continue());
+<STRING,CHAR> "\\r"   => (str := #"\r" :: !str; continue());
 <STRING,CHAR> "\\\\"  => (str := #"\\" :: !str; continue());
 <STRING,CHAR> "\\t"   => (str := #"\t" :: !str; continue());
 <STRING,CHAR> "\n"    => (newline yypos;
-- 
cgit v1.2.3


From 746e16d83aaf284f996bcc6d61f0d9ba99c099b2 Mon Sep 17 00:00:00 2001
From: Alexander Abushkevich <alex@abushkevi.ch>
Date: Tue, 23 Feb 2016 00:49:17 +1300
Subject: Find longest prefix of elements, which satisfy a predicate; Group a
 list

---
 lib/ur/list.ur  | 25 +++++++++++++++++++++++++
 lib/ur/list.urs |  6 ++++++
 2 files changed, 31 insertions(+)

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index 11895884..f3bb0587 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -434,6 +434,31 @@ fun drop [a] (n : int) (xs : list a) : list a =
 
 fun splitAt [a] (n : int) (xs : list a) : list a * list a =
     (take n xs, drop n xs)
+    
+fun span [a] (f:(a -> bool)) (ls:list a) : list a * list a  = 
+    let
+        fun span' f acc ls =
+            case ls of
+                []      =>  (acc, [])
+              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (acc, ls)
+    in
+        span' f [] ls
+    end
+    
+fun groupBy [a] (f:(a -> a -> bool)) (ls:list a) : list (list a) = 
+    let
+        fun groupBy' f ls = 
+            case ls of
+                [] => [] :: []
+              | x :: xs => 
+                    let
+                        val (ys, zs) = span (f x) xs
+                    in 
+                        (x :: ys) :: (groupBy' f zs)
+                    end
+    in
+        groupBy' f ls
+    end
 
 fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
     let
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index 55068935..ac874d7c 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -105,3 +105,9 @@ val recToList : a ::: Type -> r ::: {Unit} -> folder r -> $(mapU a r) -> t a
 val drop : t ::: Type -> int -> list t -> list t
 val take : t ::: Type -> int -> list t -> list t
 val splitAt : t ::: Type -> int -> list t -> list t * list t
+
+(** Longest prefix of elements, which satisfy a predicate *)
+val span : a ::: Type -> (a -> bool) -> t a -> t a * t a
+
+(** Group a list *)
+val groupBy : a ::: Type -> (a -> a -> bool) -> t a -> t (t a)
-- 
cgit v1.2.3


From d9957717c700eb0dfa6a2b2e0871e1a3712deafa Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 23 Feb 2016 07:22:57 -0500
Subject: Set associativity of SQL 'LIKE'

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

diff --git a/src/urweb.grm b/src/urweb.grm
index 0f499e20..968a3c44 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -573,7 +573,7 @@ fun patternOut (e : exp) =
 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL
 %right OR
 %right CAND
-%nonassoc EQ NE LT LE GT GE IS
+%nonassoc EQ NE LT LE GT GE IS LIKE
 %right ARROW
 
 %left REVAPP
-- 
cgit v1.2.3


From c4e27c0873014af57224bccee09286f1adbbfa05 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Tue, 23 Feb 2016 11:41:42 -0500
Subject: Make JavaScript escaping handle ampersands properly

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

diff --git a/src/c/urweb.c b/src/c/urweb.c
index a9a169b8..620893c0 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1568,6 +1568,10 @@ uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) {
       strcpy(s2, "\\074");
       s2 += 4;
       break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
     default:
       if (isprint((int)c) || c >= 128)
         *s2++ = c;
@@ -1609,6 +1613,10 @@ uw_Basis_string uw_Basis_jsifyChar(uw_context ctx, uw_Basis_char c1) {
     strcpy(s2, "\\074");
     s2 += 4;
     break;
+  case '&':
+    strcpy(s2, "\\046");
+    s2 += 4;
+    break;
   default:
     if (isprint((int)c) || c >= 128)
       *s2++ = c;
@@ -1647,6 +1655,10 @@ uw_Basis_string uw_Basis_jsifyString_ws(uw_context ctx, uw_Basis_string s) {
       strcpy(s2, "\\074");
       s2 += 4;
       break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
     default:
       if (isprint((int)c) || c >= 128)
         *s2++ = c;
-- 
cgit v1.2.3


From 026e50ceaad69147ae05386ea342861d18021cd5 Mon Sep 17 00:00:00 2001
From: Alexander Abushkevich <alex@abushkevi.ch>
Date: Wed, 24 Feb 2016 15:14:13 +1300
Subject: Return lists in their original order in span function

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

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index f3bb0587..eac5ab0c 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -439,8 +439,8 @@ fun span [a] (f:(a -> bool)) (ls:list a) : list a * list a  =
     let
         fun span' f acc ls =
             case ls of
-                []      =>  (acc, [])
-              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (acc, ls)
+                []      =>  (rev acc, [])
+              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (rev acc, ls)
     in
         span' f [] ls
     end
-- 
cgit v1.2.3


From b0368093645dcb7f65e131862d8ae9c81f2844f2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Fri, 26 Feb 2016 10:32:08 -0500
Subject: More consistent formatting for new List functions

---
 lib/ur/list.ur    | 26 +++++++++++++-------------
 lib/ur/list.urs   |  4 ++--
 tests/groupBy.ur  |  3 +++
 tests/groupBy.urp |  4 ++++
 4 files changed, 22 insertions(+), 15 deletions(-)
 create mode 100644 tests/groupBy.ur
 create mode 100644 tests/groupBy.urp

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index eac5ab0c..50764e46 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -435,29 +435,29 @@ fun drop [a] (n : int) (xs : list a) : list a =
 fun splitAt [a] (n : int) (xs : list a) : list a * list a =
     (take n xs, drop n xs)
     
-fun span [a] (f:(a -> bool)) (ls:list a) : list a * list a  = 
+fun span [a] (f : a -> bool) (ls : list a) : list a * list a  = 
     let
-        fun span' f acc ls =
+        fun span' ls acc =
             case ls of
                 []      =>  (rev acc, [])
-              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (rev acc, ls)
+              | x :: xs =>  if f x then span' xs (x :: acc) else (rev acc, ls)
     in
-        span' f [] ls
+        span' ls []
     end
     
-fun groupBy [a] (f:(a -> a -> bool)) (ls:list a) : list (list a) = 
+fun groupBy [a] (f : a -> a -> bool) (ls : list a) : list (list a) = 
     let
-        fun groupBy' f ls = 
+        fun groupBy' ls acc =
             case ls of
-                [] => [] :: []
+                [] => rev ([] :: acc)
               | x :: xs => 
-                    let
-                        val (ys, zs) = span (f x) xs
-                    in 
-                        (x :: ys) :: (groupBy' f zs)
-                    end
+                let
+                    val (ys, zs) = span (f x) xs
+                in 
+                    groupBy' zs ((x :: ys) :: acc)
+                end
     in
-        groupBy' f ls
+        groupBy' ls []
     end
 
 fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index ac874d7c..432d8c1a 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -106,8 +106,8 @@ val drop : t ::: Type -> int -> list t -> list t
 val take : t ::: Type -> int -> list t -> list t
 val splitAt : t ::: Type -> int -> list t -> list t * list t
 
-(** Longest prefix of elements, which satisfy a predicate *)
+(** Longest prefix of elements that satisfy a predicate, returned along with the remaining suffix *)
 val span : a ::: Type -> (a -> bool) -> t a -> t a * t a
 
-(** Group a list *)
+(** Group a list into maximal adjacent segments where all elements compare as equal, according to the provided predicate. *)
 val groupBy : a ::: Type -> (a -> a -> bool) -> t a -> t (t a)
diff --git a/tests/groupBy.ur b/tests/groupBy.ur
new file mode 100644
index 00000000..e91e33cc
--- /dev/null
+++ b/tests/groupBy.ur
@@ -0,0 +1,3 @@
+val main : transaction page = return <xml><body>
+  {[List.groupBy eq (1 :: 1 :: 2 :: 2 :: 3 :: 4 :: 4 :: 4 :: 5 :: [])]}
+</body></xml>
diff --git a/tests/groupBy.urp b/tests/groupBy.urp
new file mode 100644
index 00000000..de1db792
--- /dev/null
+++ b/tests/groupBy.urp
@@ -0,0 +1,4 @@
+rewrite all GroupBy/*
+
+$/list
+groupBy
-- 
cgit v1.2.3


From 5538a334cdeedaee0ed8d1da95e176e7a3097bf6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 6 Mar 2016 14:55:58 -0500
Subject: New release

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

diff --git a/CHANGELOG b/CHANGELOG
index 701e9c03..760c603c 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,11 @@
+========
+20160306
+========
+
+- Allow '\r' in string and character literals
+- New standard library functions: List.span and List.groupBy
+- Bug fixes
+
 ========
 20160213
 ========
diff --git a/configure.ac b/configure.ac
index 1afbfc56..27795ed8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20160213])
-WORKING_VERSION=1
+AC_INIT([urweb], [20160306])
+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 1e7a95459bc0fa25781e7d343db85f356f0eee9a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 6 Mar 2016 15:08:49 -0500
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 27795ed8..ea1125a8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
 AC_INIT([urweb], [20160306])
-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 ede4570a3048c2dc6d8c9cd2253405bb41922d69 Mon Sep 17 00:00:00 2001
From: Alexander Abushkevich <alex@abushkevi.ch>
Date: Thu, 10 Mar 2016 15:13:48 +1300
Subject: Resource integrity attributes for HTML link element.
 http://www.w3.org/TR/2015/CR-SRI-20151112/

---
 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 a4872c32..d98134ff 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -813,7 +813,7 @@ val data_attrs : data_attr -> data_attr -> data_attr
 
 val head : unit -> tag [Data = data_attr] html head [] []
 val title : unit -> tag [Data = data_attr] head [] [] []
-val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] []
+val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string] head [] [] []
 
 datatype mouseButton = Left | Right | Middle
 
-- 
cgit v1.2.3


From d2823e60805a6cc394b149563ff500ea969b8627 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 11 Mar 2016 08:16:23 -0500
Subject: Make Sql compatible with unmangling

---
 src/sql.sml      | 2 +-
 src/sqlcache.sml | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/sql.sml b/src/sql.sml
index dfe2f968..e8e82196 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -193,7 +193,7 @@ val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >=
                                         SOME (str (Char.toUpper (String.sub (s, 3)))
                                               ^ String.extract (s, 4, NONE))
                                     else
-                                        NONE)
+                                        SOME s)
 
 val field = wrap (follow (opt (follow t_ident (const ".")))
                          uw_ident)
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 75a17e48..570c7d45 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -1599,7 +1599,8 @@ fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state
             in
                 case inval of
                     (* TODO: fail more gracefully. *)
-                    NONE => raise Fail "Sqlcache: addFlushing (b)"
+                    NONE => (Print.preface ("DML", MonoPrint.p_exp MonoEnv.empty dmlText);
+                             raise Fail "Sqlcache: addFlushing (b)")
                   | SOME invs => sequence (flushes invs @ [dmlExp])
             end
           | e' => e'
-- 
cgit v1.2.3


From 6b85dbb54d5d9928a53f0f916cf0cb33c04ff87c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 12 Mar 2016 14:11:27 -0500
Subject: Sqlcache: also record script additions; do a MonoReduce afterward, to
 help Prepare do a better job

---
 include/urweb/types_cpp.h |  1 +
 include/urweb/urweb_cpp.h |  3 +++
 src/c/urweb.c             | 14 ++++++++++++--
 src/lru_cache.sml         |  4 ++++
 src/sources               |  6 +++---
 src/sqlcache.sml          |  3 ++-
 6 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h
index 77e4c611..7eb976d4 100644
--- a/include/urweb/types_cpp.h
+++ b/include/urweb/types_cpp.h
@@ -127,6 +127,7 @@ typedef struct {
 typedef struct uw_Sqlcache_Value {
   char *result;
   char *output;
+  char *scriptOutput;
   unsigned long timeValid;
 } uw_Sqlcache_Value;
 
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 916fbbf9..feebdef3 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -81,6 +81,7 @@ void uw_write(struct uw_context *, const char*);
 // For caching.
 void uw_recordingStart(struct uw_context *);
 char *uw_recordingRead(struct uw_context *);
+char *uw_recordingReadScript(struct uw_context *);
 
 uw_Basis_source uw_Basis_new_client_source(struct uw_context *, uw_Basis_string);
 uw_unit uw_Basis_set_client_source(struct uw_context *, uw_Basis_source, uw_Basis_string);
@@ -222,6 +223,8 @@ void uw_clear_headers(struct uw_context *);
 int uw_has_contentLength(struct uw_context *);
 void uw_Basis_clear_page(struct uw_context *);
 
+void uw_write_script(struct uw_context *, uw_Basis_string);
+
 uw_Basis_string uw_Basis_get_cookie(struct uw_context *, uw_Basis_string c);
 uw_unit uw_Basis_set_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure);
 uw_unit uw_Basis_clear_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 620893c0..51a122d0 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -505,7 +505,7 @@ struct uw_context {
 
   // Sqlcache.
   int numRecording, recordingCapacity;
-  int *recordingOffsets;
+  int *recordingOffsets, *scriptRecordingOffsets;
   uw_Sqlcache_Update *cacheUpdate;
   uw_Sqlcache_Update *cacheUpdateTail;
   uw_Sqlcache_Unlock *cacheUnlock;
@@ -597,6 +597,7 @@ uw_context uw_init(int id, uw_loggers *lg) {
   ctx->numRecording = 0;
   ctx->recordingCapacity = 0;
   ctx->recordingOffsets = malloc(0);
+  ctx->scriptRecordingOffsets = malloc(0);
   ctx->cacheUpdate = NULL;
   ctx->cacheUpdateTail = NULL;
 
@@ -670,6 +671,7 @@ void uw_free(uw_context ctx) {
   free(ctx->output_buffer);
 
   free(ctx->recordingOffsets);
+  free(ctx->scriptRecordingOffsets);
 
   free(ctx);
 }
@@ -1757,13 +1759,20 @@ void uw_recordingStart(uw_context ctx) {
   if (ctx->numRecording == ctx->recordingCapacity) {
     ++ctx->recordingCapacity;
     ctx->recordingOffsets = realloc(ctx->recordingOffsets, sizeof(int) * ctx->recordingCapacity);
+    ctx->scriptRecordingOffsets = realloc(ctx->scriptRecordingOffsets, sizeof(int) * ctx->recordingCapacity);
   }
   ctx->recordingOffsets[ctx->numRecording] = ctx->page.front - ctx->page.start;
+  ctx->scriptRecordingOffsets[ctx->numRecording] = ctx->script.front - ctx->script.start;
   ++ctx->numRecording;
 }
 
 char *uw_recordingRead(uw_context ctx) {
-  char *recording = ctx->page.start + ctx->recordingOffsets[--ctx->numRecording];
+  char *recording = ctx->page.start + ctx->recordingOffsets[ctx->numRecording-1];
+  return strdup(recording);
+}
+
+char *uw_recordingReadScript(uw_context ctx) {
+  char *recording = ctx->script.start + ctx->scriptRecordingOffsets[--ctx->numRecording];
   return strdup(recording);
 }
 
@@ -4587,6 +4596,7 @@ static void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) {
   if (value) {
     free(value->result);
     free(value->output);
+    free(value->scriptOutput);
     free(value);
   }
 }
diff --git a/src/lru_cache.sml b/src/lru_cache.sml
index 81000458..f582bf6f 100644
--- a/src/lru_cache.sml
+++ b/src/lru_cache.sml
@@ -116,6 +116,8 @@ fun setupQuery {index, params} =
              newline,*)
              string "    uw_write(ctx, v->output);",
              newline,
+             string "    uw_write_script(ctx, v->scriptOutput);",
+             newline,
              string "    return v->result;",
              newline,
              string "  } else {",
@@ -148,6 +150,8 @@ fun setupQuery {index, params} =
              newline,
              string "  v->output = uw_recordingRead(ctx);",
              newline,
+             string "  v->scriptOutput = uw_recordingReadScript(ctx);",
+             newline,
              (*string ("  puts(\"SQLCACHE: stored " ^ i ^ ".\");"),
              newline,*)
              string ("  uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"),
diff --git a/src/sources b/src/sources
index 8bf80bc6..1a09e7e8 100644
--- a/src/sources
+++ b/src/sources
@@ -186,9 +186,6 @@ $(SRC)/cache.sml
 $(SRC)/toy_cache.sml
 $(SRC)/lru_cache.sml
 
-$(SRC)/sqlcache.sig
-$(SRC)/sqlcache.sml
-
 $(SRC)/monoize.sig
 $(SRC)/monoize.sml
 
@@ -210,6 +207,9 @@ $(SRC)/fuse.sml
 $(SRC)/iflow.sig
 $(SRC)/iflow.sml
 
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
 $(SRC)/name_js.sig
 $(SRC)/name_js.sml
 
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 570c7d45..c97daac2 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -1724,8 +1724,9 @@ fun go file =
         (* Important that this happens after [MonoFooify.urlify] calls! *)
         val fmDecls = MonoFooify.getNewFmDecls ()
         val () = Sql.sqlcacheMode := false
+        val file = insertAfterDatatypes (file, rev fmDecls)
     in
-        insertAfterDatatypes (file, rev fmDecls)
+        MonoReduce.reduce file
     end
 
 end
-- 
cgit v1.2.3


From ce046247973013fe5dbcf3c18dd3aba889155c6c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 12 Mar 2016 15:52:41 -0500
Subject: MonoReduce: fancier test for inlining a record where each field is
 used at most once

---
 src/mono_reduce.sml | 44 +++++++++++++++++++++++++++++---------------
 1 file changed, 29 insertions(+), 15 deletions(-)

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 540d396b..5bcb6f57 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -44,6 +44,13 @@ structure SS = BinarySetFn(struct
                             val compare = String.compare
                             end)
 
+structure SLS = BinarySetFn(struct
+                             type ord_key = string list
+                             val compare = Order.joinL String.compare
+                             end)
+
+
+
 fun simpleTypeImpure tsyms =
     U.Typ.exists (fn TFun _ => true
                    | TDatatype (n, _) => IS.member (tsyms, n)
@@ -602,28 +609,35 @@ fun reduce' (file : file) =
                                 ERecord _ => true
                               | _ => false
 
+                        fun prefixFrom i (e : exp) =
+                            case #1 e of
+                                ERel i' => if i' = i then SOME [] else NONE
+                              | EField (e', s) =>
+                                (case prefixFrom i e' of
+                                     NONE => NONE
+                                   | SOME ss => SOME (ss @ [s]))
+                              | _ => NONE
+
                         fun whichProj i (e : exp) =
                             case #1 e of
-                                EPrim _ => SOME SS.empty
-                              | ERel i' => if i' = i then NONE else SOME SS.empty
-                              | ENamed _ => SOME SS.empty
-                              | ECon (_, _, NONE) => SOME SS.empty
+                                EPrim _ => SOME SLS.empty
+                              | ERel i' => if i' = i then NONE else SOME SLS.empty
+                              | ENamed _ => SOME SLS.empty
+                              | ECon (_, _, NONE) => SOME SLS.empty
                               | ECon (_, _, SOME e') => whichProj i e'
-                              | ENone _ => SOME SS.empty
+                              | ENone _ => SOME SLS.empty
                               | ESome (_, e') => whichProj i e'
-                              | EFfi _ => SOME SS.empty
+                              | EFfi _ => SOME SLS.empty
                               | EFfiApp (_, _, es) => whichProjs i (map #1 es)
                               | EApp (e1, e2) => whichProjs i [e1, e2]
                               | EAbs (_, _, _, e) => whichProj (i + 1) e
                               | EUnop (_, e1) => whichProj i e1
                               | EBinop (_, _, e1, e2) => whichProjs i [e1, e2]
                               | ERecord xets => whichProjs i (map #2 xets)
-                              | EField ((ERel i', _), s) =>
-                                if i' = i then
-                                    SOME (SS.singleton s)
-                                else
-                                    SOME SS.empty
-                              | EField (e1, _) => whichProj i e1
+                              | EField (e1, s) =>
+                                (case prefixFrom i e1 of
+                                     NONE => SOME SLS.empty
+                                   | SOME ss => SOME (SLS.singleton (ss @ [s])))
                               | ECase (e1, pes, _) =>
                                 whichProjs' i ((0, e1)
                                                :: map (fn (p, e) => (patBinds p, e)) pes)
@@ -656,12 +670,12 @@ fun reduce' (file : file) =
 
                         and whichProjs' i es =
                             case es of
-                                [] => SOME SS.empty
+                                [] => SOME SLS.empty
                               | (n, e) :: es' =>
                                 case (whichProj (i + n) e, whichProjs' i es') of
                                     (SOME m1, SOME m2) =>
-                                    if SS.isEmpty (SS.intersection (m1, m2)) then
-                                        SOME (SS.union (m1, m2))
+                                    if SLS.isEmpty (SLS.intersection (m1, m2)) then
+                                        SOME (SLS.union (m1, m2))
                                     else
                                         NONE
                                   | _ => NONE
-- 
cgit v1.2.3


From eb715ea49f6d74f5ac7b7f2967f4a86c4db0a75f Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 12 Mar 2016 20:44:00 -0500
Subject: Use IS NOT DISTINCT FROM; improve Sql parser

---
 src/monoize.sml  | 43 +++++++++++++++++++++++++------------------
 src/mysql.sml    |  3 ++-
 src/postgres.sml |  3 ++-
 src/settings.sig |  3 ++-
 src/settings.sml |  6 ++++--
 src/sql.sml      | 13 ++++++++++---
 src/sqlcache.sml |  8 ++++----
 src/sqlite.sml   |  3 ++-
 8 files changed, 51 insertions(+), 31 deletions(-)

diff --git a/src/monoize.sml b/src/monoize.sml
index 6715290f..6979474e 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2326,24 +2326,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 val body = case #1 arg1 of
                                L.CApp ((L.CFfi ("Basis", "option"), _), _) =>
-                                (L'.ECase ((L'.ERel 2, loc),
-                                           [((L'.PPrim (Prim.String (Prim.Normal, "=")), loc),
-                                             strcat [str "((",
-                                                     (L'.ERel 1, loc),
-                                                     str " ",
-                                                     (L'.ERel 2, loc),
-                                                     str " ",
-                                                     (L'.ERel 0, loc),
-                                                     str ") OR ((",
-                                                     (L'.ERel 1, loc),
-                                                     str ") IS NULL AND (",
-                                                     (L'.ERel 0, loc),
-                                                     str ") IS NULL))"]),
-                                            ((L'.PVar ("_", s), loc),
-                                             default 1)],
-                                           {disc = s,
-                                            result = s}), loc)
-                             | _ => default 0
+                               (L'.ECase ((L'.ERel 2, loc),
+                                          [((L'.PPrim (Prim.String (Prim.Normal, "=")), loc),
+                                            if #supportsIsDistinctFrom (Settings.currentDbms ()) then
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " IS NOT DISTINCT FROM ",
+                                                        (L'.ERel 0, loc),
+                                                        str "))"]
+                                            else
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " ",
+                                                        (L'.ERel 2, loc),
+                                                        str " ",
+                                                        (L'.ERel 0, loc),
+                                                        str ") OR ((",
+                                                        (L'.ERel 1, loc),
+                                                        str ") IS NULL AND (",
+                                                        (L'.ERel 0, loc),
+                                                        str ") IS NULL))"]),
+                                           ((L'.PVar ("_", s), loc),
+                                            default 1)],
+                                          {disc = s,
+                                           result = s}), loc)
+                               | _ => default 0
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
diff --git a/src/mysql.sml b/src/mysql.sml
index 692be0a2..539428f6 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1608,6 +1608,7 @@ val () = addDbms {name = "mysql",
                   falseString = "FALSE",
                   onlyUnion = true,
                   nestedRelops = false,
-                  windowFunctions = false}
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = true}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index 1c95f414..ddfe0ad6 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -1145,7 +1145,8 @@ val () = addDbms {name = "postgres",
                   falseString = "FALSE",
                   onlyUnion = false,
                   nestedRelops = true,
-                  windowFunctions = true}
+                  windowFunctions = true,
+                  supportsIsDistinctFrom = true}
 
 val () = setDbms "postgres"
 
diff --git a/src/settings.sig b/src/settings.sig
index c75f12a3..5b54ed44 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -213,7 +213,8 @@ signature SETTINGS = sig
          falseString : string,
          onlyUnion : bool,
          nestedRelops : bool,
-         windowFunctions : bool
+         windowFunctions : bool,
+         supportsIsDistinctFrom : bool
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 38ea30fc..d689824e 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -621,7 +621,8 @@ type dbms = {
      falseString : string,
      onlyUnion : bool,
      nestedRelops : bool,
-     windowFunctions: bool
+     windowFunctions: bool,
+     supportsIsDistinctFrom : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -653,7 +654,8 @@ val curDb = ref ({name = "",
                   falseString = "",
                   onlyUnion = false,
                   nestedRelops = false,
-                  windowFunctions = false} : dbms)
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff --git a/src/sql.sml b/src/sql.sml
index e8e82196..409e205c 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -221,6 +221,7 @@ datatype sqexp =
 fun cmp s r = wrap (const s) (fn () => RCmp r)
 
 val sqbrel = altL [cmp "=" Eq,
+                   cmp "IS NOT DISTINCT FROM" Eq,
                    cmp "<>" Ne,
                    cmp "<=" Le,
                    cmp "<" Lt,
@@ -334,11 +335,12 @@ fun sqexp chs =
     (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
            wrap (const "TRUE") (fn () => SqTrue),
            wrap (const "FALSE") (fn () => SqFalse),
+           wrap (follow (const "NULL::") ident) (fn ((), _) => Null),
            wrap (const "NULL") (fn () => Null),
-           wrap field Field,
-           wrap uw_ident Computed,
            wrap known SqKnown,
            wrap func SqFunc,
+           wrap field Field,
+           wrap uw_ident Computed,
            wrap (arithmetic sqexp) (fn _ => Unmodeled),
            wrap unmodeled (fn () => Unmodeled),
            wrap (if !sqlcacheMode then sqlifySqlcache else sqlify) Inj,
@@ -402,6 +404,11 @@ val orderby = log "orderby"
                                           (opt (ws (const "DESC"))))))
                     ignore)
 
+val groupby = log "groupby"
+                  (wrap (follow (ws (const "GROUP BY "))
+                                (list sqexp))
+                        ignore)
+
 val jtype = altL [wrap (const "JOIN") (fn () => Inner),
                   wrap (const "LEFT JOIN") (fn () => Left),
                   wrap (const "RIGHT JOIN") (fn () => Right),
@@ -444,7 +451,7 @@ and query chs = log "query"
                                                                   (follow query (const "))")))))
                                           (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
                                     (wrap query1 Query1))
-                               (opt orderby))
+                               (follow (opt groupby) (opt orderby)))
                           #1)
                     chs
 
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index c97daac2..83a264fd 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -1370,9 +1370,9 @@ fun cacheExp (env, exp', invalInfo, state : state) =
                                  (case arg of
                                       AsIs exp => SOME exp
                                     | Urlify exp =>
-                                      typOfExp env exp
+                                      (typOfExp env exp)
                                       <\obind\>
-                                       (fn typ => (MonoFooify.urlify env (exp, typ))))
+                                       (fn typ => MonoFooify.urlify env (exp, typ)))
                                  <\obind\>
                                   (fn arg' => SOME (arg' :: args'))))
                         (SOME [])
@@ -1588,12 +1588,12 @@ fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state
                 val inval =
                     case Sql.parse Sql.dml dmlText of
                         SOME dmlParsed =>
-                        SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of
+                        SOME (map (fn i => case IM.find (indexToInvalInfo, i) of
                                                 SOME invalInfo =>
                                                 (i, invalidations (invalInfo, dmlParsed))
                                               (* TODO: fail more gracefully. *)
                                               (* This probably means invalidating everything.... *)
-                                              | NONE => raise Fail "Sqlcache: addFlushing (a)"))
+                                              | NONE => raise Fail "Sqlcache: addFlushing (a)")
                                   (SIMM.findList (tableToIndices, tableOfDml dmlParsed)))
                       | NONE => NONE
             in
diff --git a/src/sqlite.sml b/src/sqlite.sml
index a1095709..c7694cde 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -849,6 +849,7 @@ val () = addDbms {name = "sqlite",
                   falseString = "0",
                   onlyUnion = false,
                   nestedRelops = false,
-                  windowFunctions = false}
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = true}
 
 end
-- 
cgit v1.2.3


From 12783217508fd87c962a2d4871c6d3dbbcf58dee Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 30 Mar 2016 15:39:02 -0400
Subject: At runtime, catch when we exceed 'limit inputs'

---
 src/c/request.c     |  7 ++++++-
 tests/formLimit.ur  | 11 +++++++++++
 tests/formLimit.urp |  4 ++++
 tests/formLimit.urs |  1 +
 4 files changed, 22 insertions(+), 1 deletion(-)
 create mode 100644 tests/formLimit.ur
 create mode 100644 tests/formLimit.urp
 create mode 100644 tests/formLimit.urs

diff --git a/src/c/request.c b/src/c/request.c
index d621aea7..cad84cb2 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -39,7 +39,12 @@ uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls) {
   uw_logger log_error = ls->log_error;
   uw_context ctx = uw_init(id, ls);
   int retries_left = MAX_RETRIES;
-  uw_set_app(ctx, app);
+
+  if (uw_set_app(ctx, app)) {
+    log_error(logger_data, "Unable to initialize request context.  Most likely the limit on number of form inputs has been exceeded.\n");
+    uw_free(ctx);
+    return NULL;
+  }
 
   while (1) {
     failure_kind fk = uw_begin_init(ctx);
diff --git a/tests/formLimit.ur b/tests/formLimit.ur
new file mode 100644
index 00000000..d591f736
--- /dev/null
+++ b/tests/formLimit.ur
@@ -0,0 +1,11 @@
+fun handler r = return <xml><body>
+  {[r.A]}, {[r.B]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/>
+    <textbox{#B}/>
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/formLimit.urp b/tests/formLimit.urp
new file mode 100644
index 00000000..3fd7e5c3
--- /dev/null
+++ b/tests/formLimit.urp
@@ -0,0 +1,4 @@
+rewrite all FormLimit/*
+limit inputs 1
+
+formLimit
diff --git a/tests/formLimit.urs b/tests/formLimit.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/formLimit.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
-- 
cgit v1.2.3


From e8fba960a1866d0370b20ee0e120d64c4f05f67e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Fri, 15 Apr 2016 18:02:21 -0400
Subject: Fix preservation of headers when returning blobs

---
 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 51a122d0..7e535122 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3941,7 +3941,7 @@ static char *old_headers(uw_context ctx) {
 
     if (strncasecmp(ctx->outHeaders.start, "Content-type: ", 14)) {
       s = strchr(ctx->outHeaders.start, '\n');
-      is_good = strncasecmp(s+1, "Content-type: ", 14);
+      is_good = !strncasecmp(s+1, "Content-type: ", 14);
     } else {
       s = ctx->outHeaders.start;
       is_good = 1;
-- 
cgit v1.2.3


From 6c93a0c5612190566ae65f8654cca509e1a0e0d7 Mon Sep 17 00:00:00 2001
From: Marko Schuetz-Schmuck <MarkoSchuetz@web.de>
Date: Thu, 5 May 2016 15:50:00 -0400
Subject: Streamline callout to emacs for HTML rendering.

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

diff --git a/src/demo.sml b/src/demo.sml
index 17de80ee..2ff76ad1 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -318,12 +318,13 @@ fun make' {prefix, dirname, guided} =
                                                              Posix.FileSys.ST.mtime htmlSt)
                                                  end handle OS.SysErr _ => true
 
-                                             val cmd = "emacs --eval \"(progn "
+                                             val cmd = "emacs -no-init-file --eval \"(progn "
                                                        ^ "(global-font-lock-mode t) "
                                                        ^ "(add-to-list 'load-path \\\""
                                                        ^ !Settings.configSitelisp
                                                        ^ "/\\\") "
                                                        ^ "(load \\\"urweb-mode-startup\\\") "
+                                                       ^ "(load \\\"htmlize\\\") "
                                                        ^ "(urweb-mode) "
                                                        ^ "(find-file \\\""
                                                        ^ src
-- 
cgit v1.2.3


From a0686c30f1315a6ca8c10acfca386df468f172a8 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Thu, 5 May 2016 16:55:03 -0400
Subject: Add some tests for Content-Disposition

---
 tests/contentDisposition.ur  | 4 ++++
 tests/contentDisposition.urp | 5 +++++
 2 files changed, 9 insertions(+)
 create mode 100644 tests/contentDisposition.ur
 create mode 100644 tests/contentDisposition.urp

diff --git a/tests/contentDisposition.ur b/tests/contentDisposition.ur
new file mode 100644
index 00000000..8fe2b26c
--- /dev/null
+++ b/tests/contentDisposition.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page =
+    setHeader (blessResponseHeader "Content-Disposition")
+              ("attachment; filename=test.txt");
+    returnBlob (textBlob "Hi there!") (blessMime "text/plain")
diff --git a/tests/contentDisposition.urp b/tests/contentDisposition.urp
new file mode 100644
index 00000000..92b02871
--- /dev/null
+++ b/tests/contentDisposition.urp
@@ -0,0 +1,5 @@
+rewrite all ContentDisposition/*
+allow responseHeader Content-Disposition
+allow mime text/plain
+
+contentDisposition
\ No newline at end of file
-- 
cgit v1.2.3


From d6453242560cfeaa31e74b2c77423b4ada288ac6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 15 May 2016 09:47:49 -0400
Subject: Support for <meta> tags

---
 doc/manual.tex            | 11 ++++++++++-
 include/urweb/types_cpp.h |  1 +
 include/urweb/urweb_cpp.h |  2 ++
 lib/ur/basis.urs          |  5 +++++
 src/c/urweb.c             | 28 +++++++++++++++++++++++++++
 src/cjr_print.sml         |  5 ++++-
 src/compiler.sig          |  1 +
 src/compiler.sml          |  7 +++++++
 src/demo.sml              |  1 +
 src/mono_opt.sml          | 11 +++++++++++
 src/monoize.sml           |  1 +
 src/settings.sig          |  4 ++++
 src/settings.sml          |  6 ++++++
 src/urweb.grm             | 12 +++++++++++-
 tests/meta.ur             | 48 +++++++++++++++++++++++++++++++++++++++++++++++
 tests/meta.urp            |  4 ++++
 16 files changed, 144 insertions(+), 3 deletions(-)
 create mode 100644 tests/meta.ur
 create mode 100644 tests/meta.urp

diff --git a/doc/manual.tex b/doc/manual.tex
index 0a2d6faa..76f69330 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -139,7 +139,7 @@ For each entry \texttt{M} in the module list, the file \texttt{M.urs} is include
 
 Here is the complete list of directive forms.  ``FFI'' stands for ``foreign function interface,'' Ur's facility for interaction between Ur programs and C and JavaScript libraries.
 \begin{itemize}
-\item \texttt{[allow|deny] [url|mime|requestHeader|responseHeader|env] PATTERN} registers a rule governing which URLs, MIME types, HTTP request headers, HTTP response headers, or environment variable names are allowed to appear explicitly in this application.  The first such rule to match a name determines the verdict.  If \texttt{PATTERN} ends in \texttt{*}, it is interpreted as a prefix rule.  Otherwise, a string must match it exactly.
+\item \texttt{[allow|deny] [url|mime|requestHeader|responseHeader|env|meta] PATTERN} registers a rule governing which URLs, MIME types, HTTP request headers, HTTP response headers, environment variable names, or HTML \texttt{<meta>} names are allowed to appear explicitly in this application.  The first such rule to match a name determines the verdict.  If \texttt{PATTERN} ends in \texttt{*}, it is interpreted as a prefix rule.  Otherwise, a string must match it exactly.
 \item \texttt{alwaysInline PATH} requests that every call to the referenced function be inlined.  Section \ref{structure} explains how functions are assigned path strings.
 \item \texttt{benignEffectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  Every effectful FFI function must be registered, or the optimizer may make invalid transformations.  This version of the \texttt{effectful} directive registers that this function only has side effects that remain local to a single page generation.
 \item \texttt{clientOnly Module.ident} registers an FFI function or transaction that may only be run in client browsers.
@@ -1539,6 +1539,7 @@ $$\begin{array}{l}
   \mt{val} \; \mt{returnBlob} : \mt{t} ::: \mt{Type} \to \mt{blob} \to \mt{mimeType} \to \mt{transaction} \; \mt{t}
 \end{array}$$
 
+
 \subsection{SQL}
 
 Everything about SQL database access is restricted to server-side code.
@@ -2081,6 +2082,14 @@ $$\begin{array}{l}
   \mt{val} \; \mt{error} : \mt{t} ::: \mt{Type} \to \mt{xbody} \to \mt{t}
 \end{array}$$
 
+There is limited support for the HTML \texttt{<meta>} tag, with the following type used to control which names are allowed.
+$$\begin{array}{l}
+  \mt{type} \; \mt{meta} \\
+  \mt{val} \; \mt{blessMeta} : \mt{string} \to \mt{meta} \\
+  \mt{val} \; \mt{checkMeta} : \mt{string} \to \mt{option} \; \mt{meta}
+\end{array}$$
+Configure the policy for meta names with the \texttt{allow} and \texttt{deny} \texttt{.urp} directives.
+
 
 \subsection{Client-Side Programming}
 
diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h
index 7eb976d4..47086791 100644
--- a/include/urweb/types_cpp.h
+++ b/include/urweb/types_cpp.h
@@ -96,6 +96,7 @@ typedef struct {
   int (*check_requestHeader)(const char *);
   int (*check_responseHeader)(const char *);
   int (*check_envVar)(const char *);
+  int (*check_meta)(const char *);
 
   void (*on_error)(struct uw_context *, char *);
 
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index feebdef3..5b6c6221 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -239,12 +239,14 @@ uw_Basis_string uw_Basis_blessMime(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_blessRequestHeader(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_blessResponseHeader(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_blessEnvVar(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessMeta(struct uw_context *, uw_Basis_string);
 
 uw_Basis_string uw_Basis_checkUrl(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_checkMime(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_checkRequestHeader(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_checkResponseHeader(struct uw_context *, uw_Basis_string);
 uw_Basis_string uw_Basis_checkEnvVar(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkMeta(struct uw_context *, uw_Basis_string);
 
 uw_Basis_string uw_Basis_getHeader(struct uw_context *, uw_Basis_string name);
 uw_unit uw_Basis_setHeader(struct uw_context *, uw_Basis_string name, uw_Basis_string value);
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index d98134ff..883cc5b1 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -208,6 +208,10 @@ val blessEnvVar : string -> envVar
 val checkEnvVar : string -> option envVar
 val getenv : envVar -> transaction (option string)
 
+type meta
+val blessMeta : string -> meta
+val checkMeta : string -> option meta
+
 
 (** JavaScript-y gadgets *)
 
@@ -814,6 +818,7 @@ val data_attrs : data_attr -> data_attr -> data_attr
 val head : unit -> tag [Data = data_attr] html head [] []
 val title : unit -> tag [Data = data_attr] head [] [] []
 val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string] head [] [] []
+val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] []
 
 datatype mouseButton = Left | Right | Middle
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 7e535122..c23366fb 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3835,6 +3835,34 @@ uw_Basis_string uw_Basis_checkEnvVar(uw_context ctx, uw_Basis_string s) {
     return NULL;
 }
 
+static int meta_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalpha((int)*s) && *s != '-')
+      return 0;
+
+  return 1;
+}
+
+uw_Basis_string uw_Basis_blessMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    uw_error(ctx, FATAL, "Meta name \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed meta name %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    return NULL;
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    return NULL;
+}
+
 uw_Basis_string uw_Basis_getHeader(uw_context ctx, uw_Basis_string name) {
   return uw_Basis_requestHeader(ctx, name);
 }
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 2471ce59..b2c85a54 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3468,6 +3468,9 @@ fun p_file env (ds, ps) =
              makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()),
              newline,
 
+             makeChecker ("uw_check_meta", Settings.getMetaRules ()),
+             newline,
+
              string "extern void uw_sign(const char *in, char *out);",
              newline,
              string "extern int uw_hash_blocksize;",
@@ -3652,7 +3655,7 @@ fun p_file env (ds, ps) =
                          "uw_client_init", "uw_initializer", "uw_expunger",
                          "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close",
                          "uw_handle",
-                         "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar",
+                         "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar", "uw_check_meta",
                          case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics",
                          "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\"",
                          if Settings.getIsHtml5 () then "1" else "0"],
diff --git a/src/compiler.sig b/src/compiler.sig
index c154240a..a4b3e562 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -55,6 +55,7 @@ signature COMPILER = sig
          filterRequest : Settings.rule list,
          filterResponse : Settings.rule list,
          filterEnv : Settings.rule list,
+         filterMeta : Settings.rule list,
          protocol : string option,
          dbms : string option,
          sigFile : string option,
diff --git a/src/compiler.sml b/src/compiler.sml
index 7580c5e4..76743fad 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -59,6 +59,7 @@ type job = {
      filterRequest : Settings.rule list,
      filterResponse : Settings.rule list,
      filterEnv : Settings.rule list,
+     filterMeta : Settings.rule list,
      protocol : string option,
      dbms : string option,
      sigFile : string option,
@@ -374,6 +375,7 @@ fun institutionalizeJob (job : job) =
      Settings.setRequestHeaderRules (#filterRequest job);
      Settings.setResponseHeaderRules (#filterResponse job);
      Settings.setEnvVarRules (#filterEnv job);
+     Settings.setMetaRules (#filterMeta job);
      Option.app Settings.setProtocol (#protocol job);
      Option.app Settings.setDbms (#dbms job);
      Settings.setSafeGets (#safeGets job);
@@ -453,6 +455,7 @@ fun parseUrp' accLibs fname =
                         filterRequest = [],
                         filterResponse = [],
                         filterEnv = [],
+                        filterMeta = [],
                         protocol = NONE,
                         dbms = NONE,
                         sigFile = NONE,
@@ -574,6 +577,7 @@ fun parseUrp' accLibs fname =
                      val request = ref []
                      val response = ref []
                      val env = ref []
+                     val meta = ref []
                      val libs = ref []
                      val protocol = ref NONE
                      val dbms = ref NONE
@@ -610,6 +614,7 @@ fun parseUrp' accLibs fname =
                                  filterRequest = rev (!request),
                                  filterResponse = rev (!response),
                                  filterEnv = rev (!env),
+                                 filterMeta = rev (!meta),
                                  sources = sources,
                                  protocol = !protocol,
                                  dbms = !dbms,
@@ -667,6 +672,7 @@ fun parseUrp' accLibs fname =
                                  filterRequest = #filterRequest old @ #filterRequest new,
                                  filterResponse = #filterResponse old @ #filterResponse new,
                                  filterEnv = #filterEnv old @ #filterEnv new,
+                                 filterMeta = #filterMeta old @ #filterMeta new,
                                  sources = #sources new
                                            @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
                                                          (#sources old),
@@ -710,6 +716,7 @@ fun parseUrp' accLibs fname =
                            | "requestHeader" => request
                            | "responseHeader" => response
                            | "env" => env
+                           | "meta" => meta
                            | _ => (ErrorMsg.error "Bad filter kind";
                                    url)
 
diff --git a/src/demo.sml b/src/demo.sml
index 2ff76ad1..0d9f0f4f 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -118,6 +118,7 @@ fun make' {prefix, dirname, guided} =
             filterRequest = #filterRequest combined @ #filterRequest urp,
             filterResponse = #filterResponse combined @ #filterResponse urp,
             filterEnv = #filterEnv combined @ #filterEnv urp,
+            filterMeta = #filterMeta combined @ #filterMeta urp,
             protocol = mergeWith #2 (#protocol combined, #protocol urp),
             dbms = mergeWith #2 (#dbms combined, #dbms urp),
             sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 186f6c62..40b865b0 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -539,6 +539,17 @@ fun exp e =
              ESome ((TFfi ("Basis", "string"), loc), (se, loc))
          else
              ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMeta'");
+         se)
+      | EFfiApp ("Basis", "checkMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
 
       | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) =>
         let
diff --git a/src/monoize.sml b/src/monoize.sml
index 6979474e..86f2b4a5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -234,6 +234,7 @@ fun monoType env =
                   | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "meta") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc)
 
diff --git a/src/settings.sig b/src/settings.sig
index 5b54ed44..dd135bda 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -133,6 +133,10 @@ signature SETTINGS = sig
     val getEnvVarRules : unit -> rule list
     val checkEnvVar : string -> bool
 
+    val setMetaRules : rule list -> unit
+    val getMetaRules : unit -> rule list
+    val checkMeta : string -> bool
+
     (* Web protocols that generated programs may speak *)
     type protocol = {
         name : string,       (* Call it this on the command line *)
diff --git a/src/settings.sml b/src/settings.sml
index d689824e..85cab207 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -460,18 +460,21 @@ val mime = ref ([] : rule list)
 val request = ref ([] : rule list)
 val response = ref ([] : rule list)
 val env = ref ([] : rule list)
+val meta = ref ([] : rule list)
 
 fun setUrlRules ls = url := ls
 fun setMimeRules ls = mime := ls
 fun setRequestHeaderRules ls = request := ls
 fun setResponseHeaderRules ls = response := ls
 fun setEnvVarRules ls = env := ls
+fun setMetaRules ls = meta := ls
 
 fun getUrlRules () = !url
 fun getMimeRules () = !mime
 fun getRequestHeaderRules () = !request
 fun getResponseHeaderRules () = !response
 fun getEnvVarRules () = !env
+fun getMetaRules () = !meta
 
 fun check f rules s =
     let
@@ -500,11 +503,13 @@ val checkUrl = check (fn _ => true) url
 
 val validMime = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"." orelse ch = #"+")
 val validEnv = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #".")
+val validMeta = CharVector.all (fn ch => Char.isAlpha ch orelse ch = #"-")
 
 val checkMime = check validMime mime
 val checkRequestHeader = check validMime request
 val checkResponseHeader = check validMime response
 val checkEnvVar = check validEnv env
+val checkMeta = check validMeta meta
 
 
 type protocol = {
@@ -952,6 +957,7 @@ fun reset () =
      request := [];
      response := [];
      env := [];
+     meta := [];
      debug := false;
      dbstring := NONE;
      exe := NONE;
diff --git a/src/urweb.grm b/src/urweb.grm
index 968a3c44..40101056 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2014, Adam Chlipala
+(* Copyright (c) 2008-2016, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -1780,6 +1780,16 @@ attr   : SYMBOL EQ attrv                (case SYMBOL of
                                                                      (EApp ((EVar (["Basis"], "bless", Infer), loc),
                                                                             attrv), loc)
                                                                  end
+                                                             else if sym = "Nam"
+                                                                andalso (case #1 attrv of
+                                                                             EPrim _ => true
+                                                                           | _ => false) then
+                                                                 let
+                                                                     val loc = s (attrvleft, attrvright)
+                                                                 in
+                                                                     (EApp ((EVar (["Basis"], "blessMeta", Infer), loc),
+                                                                            attrv), loc)
+                                                                 end
                                                              else
                                                                  attrv)
                                                  end)
diff --git a/tests/meta.ur b/tests/meta.ur
new file mode 100644
index 00000000..f8d12183
--- /dev/null
+++ b/tests/meta.ur
@@ -0,0 +1,48 @@
+fun main () : transaction page =
+    let
+        fun handler r = return <xml>
+          <head>
+            <meta name={blessMeta r.Nam} content={r.Content}/>
+            <title>Testing &lt;meta> tags</title>
+          </head>
+          <body>
+            <p>Did it work?</p>
+          </body>
+        </xml>
+
+        fun handler2 r =
+            case checkMeta r.Nam of
+                None => error <xml>Oh, that name won't do at all.</xml>
+              | Some name =>
+                return <xml>
+                  <head>
+                    <meta name={name} content={r.Content}/>
+                    <title>Testing &lt;meta> tags</title>
+                  </head>
+                  <body>
+                    <p>Did it work?</p>
+                  </body>
+                </xml>
+    in
+        return <xml>
+          <head>
+            <meta name="viewport" content="width=device-width, initial-scale=1.0"/>
+            <title>Testing &lt;meta> tags</title>
+          </head>
+          <body>
+            <p>Did it work?</p>
+
+            <form>
+              Name: <textbox{#Nam}/><br/>
+              Content: <textbox{#Content}/><br/>
+              <submit action={handler}/>
+            </form>
+
+            <form>
+              Name: <textbox{#Nam}/><br/>
+              Content: <textbox{#Content}/><br/>
+              <submit action={handler2}/>
+            </form>
+          </body>
+        </xml>
+    end
diff --git a/tests/meta.urp b/tests/meta.urp
new file mode 100644
index 00000000..95ede782
--- /dev/null
+++ b/tests/meta.urp
@@ -0,0 +1,4 @@
+rewrite all Meta/*
+allow meta viewport
+
+meta
-- 
cgit v1.2.3


From 359c1ca68f97181dada92e28440c7336fc88fff5 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 15 May 2016 12:37:54 -0400
Subject: New release

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

diff --git a/CHANGELOG b/CHANGELOG
index 760c603c..bec77354 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,11 @@
+========
+20160515
+========
+
+- Support for HTML <meta> tags
+- Resource-integrity attributes for HTML <link>
+- Bug fixes and optimization improvements
+
 ========
 20160306
 ========
diff --git a/configure.ac b/configure.ac
index ea1125a8..2a09d3b5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20160306])
-WORKING_VERSION=1
+AC_INIT([urweb], [20160515])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
-- 
cgit v1.2.3