From 36d3dc318f697a28e725ad6512f827af268f6532 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 25 Feb 2011 11:27:16 -0500 Subject: sql_arith_option; 'ALL' for relational operators --- lib/ur/basis.urs | 6 ++++-- src/monoize.sml | 62 ++++++++++++++++++++++++++++++++++++++++---------------- src/urweb.grm | 14 ++++++++----- 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) -- cgit v1.2.3