Mercurial > urweb
changeset 229:016d71e878c1
Relational operators; string literals for SQL
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 21 Aug 2008 15:27:04 -0400 |
| parents | 19e5791923d0 |
| children | 87d41ac28b30 |
| files | lib/basis.lig src/lacweb.grm src/lacweb.lex tests/relops.lac |
| diffstat | 4 files changed, 71 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/basis.lig Thu Aug 21 14:45:31 2008 -0400 +++ b/lib/basis.lig Thu Aug 21 15:27:04 2008 -0400 @@ -14,6 +14,7 @@ (*** Queries *) con sql_query :: {{Type}} -> Type +con sql_query1 :: {{Type}} -> {{Type}} -> Type con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type con sql_subset :: {{Type}} -> {{Type}} -> Type @@ -28,7 +29,7 @@ val sql_subset_all : tables :: {{Type}} -> sql_subset tables tables -val sql_query : tables ::: {{Type}} +val sql_query1 : tables ::: {{Type}} -> grouped ::: {{Type}} -> selected ::: {{Type}} -> {From : $(fold (fn nm => fn fields :: {Type} => fn acc => @@ -37,6 +38,21 @@ GroupBy : sql_subset tables grouped, Having : sql_exp grouped tables bool, SelectFields : sql_subset grouped selected} + -> sql_query1 tables selected + +type sql_relop +val sql_union : sql_relop +val sql_intersect : sql_relop +val sql_except : sql_relop +val sql_relop : sql_relop + -> tables1 ::: {{Type}} + -> tables2 ::: {{Type}} + -> selected ::: {{Type}} + -> sql_query1 tables1 selected -> sql_query1 tables2 selected -> sql_query1 selected selected + +val sql_query : tables ::: {{Type}} + -> selected ::: {{Type}} + -> sql_query1 tables selected -> sql_query selected val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type -> agg ::: {{Type}}
--- a/src/lacweb.grm Thu Aug 21 14:45:31 2008 -0400 +++ b/src/lacweb.grm Thu Aug 21 15:27:04 2008 -0400 @@ -129,6 +129,15 @@ (EApp (e, sqlexp), loc) end +fun sql_relop (oper, sqlexp1, sqlexp2, loc) = + let + val e = (EVar (["Basis"], "sql_relop"), loc) + val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) + val e = (EApp (e, sqlexp1), loc) + in + (EApp (e, sqlexp2), loc) + end + %% %header (functor LacwebLrValsFn(structure Token : TOKEN)) @@ -153,6 +162,7 @@ | BEGIN_TAG of string | END_TAG of string | SELECT | FROM | AS | CWHERE | GROUP | BY | HAVING + | UNION | INTERSECT | EXCEPT | TRUE | FALSE | CAND | OR | NOT | NE | LT | LE | GT | GE @@ -247,6 +257,7 @@ %nonassoc DARROW %nonassoc COLON %nonassoc DCOLON TCOLON +%left UNION INTERSECT EXCEPT %right COMMA %right OR %right CAND @@ -644,7 +655,11 @@ | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) | LBRACE eexp RBRACE (eexp) -query : query1 (query1) +query : query1 (let + val loc = s (query1left, query1right) + in + (EApp ((EVar (["Basis"], "sql_query"), loc), query1), loc) + end) query1 : SELECT select FROM tables wopt gopt hopt (let @@ -691,7 +706,7 @@ (CRecord tabs, loc)), loc) end - val e = (EVar (["Basis"], "sql_query"), loc) + val e = (EVar (["Basis"], "sql_query1"), loc) val re = (ERecord [((CName "From", loc), (ERecord tables, loc)), ((CName "Where", loc), @@ -708,6 +723,9 @@ 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))) tables : table ([table]) | table COMMA tables (table :: tables) @@ -748,6 +766,9 @@ | FLOAT (sql_inject (EPrim (Prim.Float FLOAT), EVar (["Basis"], "sql_float"), s (FLOATleft, FLOATright))) + | STRING (sql_inject (EPrim (Prim.String STRING), + EVar (["Basis"], "sql_string"), + s (STRINGleft, STRINGright))) | tident DOT fident (let val loc = s (tidentleft, fidentright)
--- a/src/lacweb.lex Thu Aug 21 14:45:31 2008 -0400 +++ b/src/lacweb.lex Thu Aug 21 15:27:04 2008 -0400 @@ -59,6 +59,7 @@ end end +val strEnder = ref #"\"" val str = ref ([] : char list) val strStart = ref 0 @@ -141,16 +142,25 @@ <COMMENT> "*)" => (if exitComment () then YYBEGIN INITIAL else (); continue ()); -<INITIAL> "\"" => (YYBEGIN STRING; strStart := pos yypos; str := []; continue()); +<INITIAL> "\"" => (YYBEGIN STRING; strEnder := #"\""; strStart := pos yypos; str := []; continue()); +<INITIAL> "'" => (YYBEGIN STRING; strEnder := #"'"; strStart := pos yypos; str := []; continue()); <STRING> "\\\"" => (str := #"\"" :: !str; continue()); -<STRING> "\"" => (if !xmlString then - (xmlString := false; YYBEGIN XMLTAG) - else - YYBEGIN INITIAL; - Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1)); +<STRING> "\\'" => (str := #"'" :: !str; continue()); <STRING> "\n" => (newline yypos; str := #"\n" :: !str; continue()); -<STRING> . => (str := String.sub (yytext, 0) :: !str; continue()); +<STRING> . => (let + val ch = String.sub (yytext, 0) + in + if ch = !strEnder then + (if !xmlString then + (xmlString := false; YYBEGIN XMLTAG) + else + YYBEGIN INITIAL; + Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1)) + else + (str := ch :: !str; + continue ()) + end); <INITIAL> "<" {id} ">"=> (let val tag = String.substring (yytext, 1, size yytext - 2) @@ -299,6 +309,10 @@ <INITIAL> "BY" => (Tokens.BY (pos yypos, pos yypos + size yytext)); <INITIAL> "HAVING" => (Tokens.HAVING (pos yypos, pos yypos + size yytext)); +<INITIAL> "UNION" => (Tokens.UNION (pos yypos, pos yypos + size yytext)); +<INITIAL> "INTERSECT" => (Tokens.INTERSECT (pos yypos, pos yypos + size yytext)); +<INITIAL> "EXCEPT" => (Tokens.EXCEPT (pos yypos, pos yypos + size yytext)); + <INITIAL> "TRUE" => (Tokens.TRUE (pos yypos, pos yypos + size yytext)); <INITIAL> "FALSE" => (Tokens.FALSE (pos yypos, pos yypos + size yytext)); <INITIAL> "AND" => (Tokens.CAND (pos yypos, pos yypos + size yytext));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/relops.lac Thu Aug 21 15:27:04 2008 -0400 @@ -0,0 +1,10 @@ +table t1 : {A : int, B : string, C : float} +table t2 : {A : float, D : int} + +val q1 = (SELECT * FROM t1 + UNION SELECT * FROM t1) +val q2 = (SELECT t1.A, t1.B FROM t1 WHERE t1.A = 0 + INTERSECT SELECT t1.B, t1.A FROM t1 WHERE t1.B = t1.B) +val q3 = (SELECT t1.A, t1.B, t1.C FROM t1 WHERE t1.A = 0 + INTERSECT SELECT * FROM t1 WHERE t1.B = 'Hello world!' + EXCEPT SELECT * FROM t1 WHERE t1.A < t1.A)