sql_arith_option; 'ALL' for relational operators

2 files changed, 53 insertions, 23 deletions

diff --git a/src/monoize.sml b/src/monoize.sml
index 9f76dbee..856cd43e 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2571,25 +2571,47 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 (if #nestedRelops (Settings.currentDbms ()) then
-                     (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 [sc "((",
-                                                           (L'.ERel 1, loc),
-                                                           sc ") ",
-                                                           (L'.ERel 2, loc),
-                                                           sc " (",
-                                                           (L'.ERel 0, loc),
-                                                           sc "))"]), loc)), loc)), loc)
+                     (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                               (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                         (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                                   (L'.EAbs ("e2", s, s,
+                                                             strcat [sc "((",
+                                                                     (L'.ERel 1, loc),
+                                                                     sc ") ",
+                                                                     (L'.ERel 3, loc),
+                                                                     (L'.ECase ((L'.ERel 2, loc),
+                                                                                [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
+                                                                                                                 datatyp = "bool",
+                                                                                                                 con = "True",
+                                                                                                                 arg = NONE}, NONE), loc),
+                                                                                  sc " ALL"),
+                                                                                 ((L'.PWild, loc),
+                                                                                  sc "")],
+                                                                                {disc = (L'.TFfi ("Basis", "bool"), loc),
+                                                                                 result = s}), loc),
+                                                                     sc " (",
+                                                                     (L'.ERel 0, loc),
+                                                                     sc "))"]), loc)), loc)), loc)), loc)
                  else
-                   (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 [(L'.ERel 1, loc),
-                                                           sc " ",
-                                                           (L'.ERel 2, loc),
-                                                           sc " ",
-                                                           (L'.ERel 0, loc)]), loc)), loc)), loc),
+                     (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                               (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                         (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                                   (L'.EAbs ("e2", s, s,
+                                                             strcat [(L'.ERel 1, loc),
+                                                                     sc " ",
+                                                                     (L'.ERel 3, loc),
+                                                                     (L'.ECase ((L'.ERel 2, loc),
+                                                                                [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
+                                                                                                                 datatyp = "bool",
+                                                                                                                 con = "True",
+                                                                                                                 arg = NONE}, NONE), loc),
+                                                                                  sc " ALL"),
+                                                                                 ((L'.PWild, loc),
+                                                                                  sc "")],
+                                                                                {disc = (L'.TFfi ("Basis", "bool"), loc),
+                                                                                 result = s}), loc),
+                                                                     sc " ",
+                                                                     (L'.ERel 0, loc)]), loc)), loc)), loc)), loc),
                  fm)
             end
           | L.ECApp (
@@ -2682,6 +2704,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
           | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm)
           | L.EFfi ("Basis", "sql_arith_float") => ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_arith_option"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                       (L'.ERecord [], loc)), loc),
+             fm)
 
           | L.EFfi ("Basis", "sql_maxable_int") => ((L'.ERecord [], loc), fm)
           | L.EFfi ("Basis", "sql_maxable_float") => ((L'.ERecord [], loc), fm)
diff --git a/src/urweb.grm b/src/urweb.grm
index c6f2587f..f57f7a64 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -145,10 +145,11 @@ fun sql_unary (oper, sqlexp, loc) =
         (EApp (e, sqlexp), loc)
     end
 
-fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
+fun sql_relop (oper, all, sqlexp1, sqlexp2, loc) =
     let
         val e = (EVar (["Basis"], "sql_relop", Infer), loc)
         val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+        val e = (EApp (e, (EVar (["Basis"], if all then "True" else "False", Infer), loc)), loc)
         val e = (EApp (e, sqlexp1), loc)
     in
         (EApp (e, sqlexp2), loc)
@@ -403,7 +404,7 @@ fun tnamesOf (e, _) =
 %left ORELSE
 %nonassoc COLON
 %nonassoc DCOLON TCOLON DCOLONWILD TCOLONWILD
-%left UNION INTERSECT EXCEPT
+%left UNION INTERSECT EXCEPT ALL
 %right COMMA
 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL
 %right OR
@@ -1600,9 +1601,12 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
                                          in
                                              e
                                          end)
-       | query1 UNION query1            (sql_relop ("union", query11, query12, s (query11left, query12right)))
-       | query1 INTERSECT query1        (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
-       | query1 EXCEPT query1           (sql_relop ("except", query11, query12, s (query11left, query12right)))
+       | query1 UNION query1            (sql_relop ("union", false, query11, query12, s (query11left, query12right)))
+       | query1 INTERSECT query1        (sql_relop ("intersect", false, query11, query12, s (query11left, query12right)))
+       | query1 EXCEPT query1           (sql_relop ("except", false, query11, query12, s (query11left, query12right)))
+       | query1 UNION ALL query1        (sql_relop ("union", true, query11, query12, s (query11left, query12right)))
+       | query1 INTERSECT ALL query1    (sql_relop ("intersect", true, query11, query12, s (query11left, query12right)))
+       | query1 EXCEPT ALL query1       (sql_relop ("except", true, query11, query12, s (query11left, query12right)))
        | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
 
 tables : fitem                          (fitem)