From 736665b9b6975af4dbb3f68cec31fb75d77915f2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 1 Nov 2015 17:02:16 -0500
Subject: Change behavior of SQL equality to do the intuitive thing for
 nullable types

---
 lib/ur/basis.urs |  3 +++
 src/monoize.sml  | 39 +++++++++++++++++++++++++++++++--------
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index e4eaa0a9..a4872c32 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -554,6 +554,9 @@ val sql_div : t ::: Type -> sql_arith t -> sql_binary t t t
 val sql_mod : sql_binary int int int
 
 val sql_eq : t ::: Type -> sql_binary t t bool
+(* Note that the semantics of this operator on nullable types are different than for standard SQL!
+ * Instead, we do it the sane way, where [NULL = NULL]. *)
+
 val sql_ne : t ::: Type -> sql_binary t t bool
 val sql_lt : t ::: Type -> sql_binary t t bool
 val sql_le : t ::: Type -> sql_binary t t bool
diff --git a/src/monoize.sml b/src/monoize.sml
index 8934db2c..dd2c41c5 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2592,22 +2592,45 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  _), _),
                 _), _),
                _), _),
-              _), _),
+              arg1), _),
              _), _),
             _) =>
             let
                 val s = (L'.TFfi ("Basis", "string"), loc)
+
+                val default = strcat [str "(",
+                                      (L'.ERel 1, loc),
+                                      str " ",
+                                      (L'.ERel 2, loc),
+                                      str " ",
+                                      (L'.ERel 0, loc),
+                                      str ")"]
+
+                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'.PWild, loc),
+                                             default)],
+                                           {disc = s,
+                                            result = s}), loc)
+                             | _ => default
             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 [str "(",
-                                                       (L'.ERel 1, loc),
-                                                       str " ",
-                                                       (L'.ERel 2, loc),
-                                                       str " ",
-                                                       (L'.ERel 0, loc),
-                                                       str ")"]), loc)), loc)), loc),
+                                               body), loc)), loc)), loc),
                  fm)
             end
           | L.EFfi ("Basis", "sql_and") => (str "AND", fm)
-- 
cgit v1.2.3