From 6d87f78102bba77bc090ca3fb105597d3ce3748f Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Fri, 14 Dec 2018 12:33:29 -0500
Subject: Proper ignoring of empty SQL updates

---
 src/monoize.sml       | 31 ++++++++++++++++++++++++++++---
 tests/emptyUpdate.ur  |  6 ++++++
 tests/emptyUpdate.urp |  4 ++++
 3 files changed, 38 insertions(+), 3 deletions(-)
 create mode 100644 tests/emptyUpdate.ur
 create mode 100644 tests/emptyUpdate.urp

diff --git a/src/monoize.sml b/src/monoize.sml
index dfa88be3..48001a13 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1540,17 +1540,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
           | L.EFfiApp ("Basis", "dml", [(e, _)]) =>
             let
+                val string = (L'.TFfi ("Basis", "string"), loc)
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                ((L'.EDml (e, L'.Error), loc),
+                ((L'.ECase (e,
+                            [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                              (L'.ERecord [], loc)),
+                             ((L'.PVar ("cmd", string), loc),
+                              (L'.EDml ((L'.ERel 0, loc), L'.Error), loc))],
+                            {disc = string,
+                             result = (L'.TRecord [], loc)}), loc),
                  fm)
             end
 
           | L.EFfiApp ("Basis", "tryDml", [(e, _)]) =>
             let
+                val string = (L'.TFfi ("Basis", "string"), loc)
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                ((L'.EDml (e, L'.None), loc),
+                ((L'.ECase (e,
+                            [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                              (L'.ERecord [], loc)),
+                             ((L'.PVar ("cmd", string), loc),
+                              (L'.EDml ((L'.ERel 0, loc), L'.None), loc))],
+                            {disc = string,
+                             result = (L'.TRecord [], loc)}), loc),
                  fm)
             end
 
@@ -1579,7 +1593,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
           | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "update"), _), _), _), _), _), changed) =>
             (case monoType env (L.TRecord changed, loc) of
-                 (L'.TRecord changed, _) =>
+                 (L'.TRecord [], _)  =>
+                 let
+                     val s = (L'.TFfi ("Basis", "string"), loc)
+                     val rt = (L'.TRecord [], 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,
+                                                    str ""), loc)), loc)), loc),
+                      fm)
+                 end
+               | (L'.TRecord changed, _) =>
                  let
                      val s = (L'.TFfi ("Basis", "string"), loc)
                      val changed = map (fn (x, _) => (x, s)) changed
diff --git a/tests/emptyUpdate.ur b/tests/emptyUpdate.ur
new file mode 100644
index 00000000..0402d78a
--- /dev/null
+++ b/tests/emptyUpdate.ur
@@ -0,0 +1,6 @@
+table a : { B : int }
+
+fun main () : transaction page =
+    dml (update [[]] {} a (WHERE TRUE));
+    return <xml></xml>
+    
diff --git a/tests/emptyUpdate.urp b/tests/emptyUpdate.urp
new file mode 100644
index 00000000..42cc98e2
--- /dev/null
+++ b/tests/emptyUpdate.urp
@@ -0,0 +1,4 @@
+database dbname=test
+safeGet EmptyUpdate/main
+
+emptyUpdate
-- 
cgit v1.2.3