Use IS NOT DISTINCT FROM; improve Sql parser

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