changeset 1427:541673c3161d

sql_arith_option; 'ALL' for relational operators
author Adam Chlipala <adam@chlipala.net>
date Fri, 25 Feb 2011 11:27:16 -0500
parents 6365d10cd326
children 58c9c039582a
files lib/ur/basis.urs src/monoize.sml src/urweb.grm
diffstat 3 files changed, 57 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Tue Feb 22 09:39:02 2011 -0500
+++ b/lib/ur/basis.urs	Fri Feb 25 11:27:16 2011 -0500
@@ -384,6 +384,7 @@
                 -> selectedFields ::: {{Type}}
                 -> selectedExps ::: {Type}
                 -> sql_relop
+                -> bool (* ALL *)
                 -> sql_query1 free afree tables1 selectedFields selectedExps
                 -> sql_query1 free afree tables2 selectedFields selectedExps
                 -> sql_query1 free afree [] selectedFields selectedExps
@@ -448,8 +449,9 @@
                   -> sql_exp tables agg exps bool
 
 class sql_arith
-val sql_int_arith : sql_arith int
-val sql_float_arith : sql_arith float
+val sql_arith_int : sql_arith int
+val sql_arith_float : sql_arith float
+val sql_arith_option : t ::: Type -> sql_arith t -> sql_arith (option t)
 
 con sql_unary :: Type -> Type -> Type
 val sql_not : sql_unary bool bool
--- a/src/monoize.sml	Tue Feb 22 09:39:02 2011 -0500
+++ b/src/monoize.sml	Fri Feb 25 11:27:16 2011 -0500
@@ -2571,25 +2571,47 @@
                 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 @@
 
           | 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)
--- a/src/urweb.grm	Tue Feb 22 09:39:02 2011 -0500
+++ b/src/urweb.grm	Fri Feb 25 11:27:16 2011 -0500
@@ -145,10 +145,11 @@
         (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 @@
 %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 @@
                                          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)