summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2015-11-01 17:02:16 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2015-11-01 17:02:16 -0500
commitdc8c8ed99b79e4f3c3c38f131dd7563148524591 (patch)
tree6fc5bda32c27ba5f8bca4712c5fe95b743dbe798
parentc0670f7c2517948966a5c037b401304a67bb85c6 (diff)
Change behavior of SQL equality to do the intuitive thing for nullable types
-rw-r--r--lib/ur/basis.urs3
-rw-r--r--src/monoize.sml39
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)