summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-02-25 11:27:16 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-02-25 11:27:16 -0500
commit36d3dc318f697a28e725ad6512f827af268f6532 (patch)
treecf7eb31deb39a78b07d8b96084d36c49388fa1bf
parent20530a508b5e0c39f7c8aebf3e1107ba08e3de10 (diff)
sql_arith_option; 'ALL' for relational operators
Diffstat
-rw-r--r--lib/ur/basis.urs6
-rw-r--r--src/monoize.sml62
-rw-r--r--src/urweb.grm14
3 files changed, 57 insertions, 25 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 795b4f9a..aefe82b7 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -384,6 +384,7 @@ val sql_relop : free ::: {{Type}}
-> 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 @@ val sql_is_null : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
-> 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
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-30 12:36:00 +0000