Mercurial > urweb
changeset 749:16bfd9e244cd
INNER JOIN
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 28 Apr 2009 10:11:56 -0400 |
| parents | 5f9b9972e6b8 |
| children | 059074c8d2fc |
| files | lib/ur/basis.urs src/elisp/urweb-mode.el src/monoize.sml src/urweb.grm src/urweb.lex tests/join.ur |
| diffstat | 6 files changed, 70 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/basis.urs Tue Apr 28 09:45:17 2009 -0400 +++ b/lib/ur/basis.urs Tue Apr 28 10:11:56 2009 -0400 @@ -229,6 +229,11 @@ -> [tabs1 ~ tabs2] => sql_from_items tabs1 -> sql_from_items tabs2 -> sql_from_items (tabs1 ++ tabs2) +val sql_inner_join : tabs1 ::: {{Type}} -> tabs2 ::: {{Type}} + -> [tabs1 ~ tabs2] + => sql_from_items tabs1 -> sql_from_items tabs2 + -> sql_exp (tabs1 ++ tabs2) [] [] bool + -> sql_from_items (tabs1 ++ tabs2) val sql_query1 : tables ::: {{Type}} -> grouped ::: {{Type}}
--- a/src/elisp/urweb-mode.el Tue Apr 28 09:45:17 2009 -0400 +++ b/src/elisp/urweb-mode.el Tue Apr 28 10:11:56 2009 -0400 @@ -149,7 +149,8 @@ "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX" "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE" "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK" - "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL") + "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL" + "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS") "A regexp that matches SQL keywords.") (defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>"
--- a/src/monoize.sml Tue Apr 28 09:45:17 2009 -0400 +++ b/src/monoize.sml Tue Apr 28 10:11:56 2009 -0400 @@ -1728,6 +1728,22 @@ (L'.ERel 0, loc)]), loc)), loc), fm) end + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_inner_join"), _), _), _), _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), + (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc), + (L'.EAbs ("on", s, s, + strcat [(L'.EPrim (Prim.String "("), loc), + (L'.ERel 2, loc), + (L'.EPrim (Prim.String " JOIN "), loc), + (L'.ERel 1, loc), + (L'.EPrim (Prim.String " ON "), loc), + (L'.ERel 0, loc), + (L'.EPrim (Prim.String ")"), loc)]), loc)), loc)), loc), + fm) + end | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => ((L'.EPrim (Prim.String ""), loc), fm)
--- a/src/urweb.grm Tue Apr 28 09:45:17 2009 -0400 +++ b/src/urweb.grm Tue Apr 28 10:11:56 2009 -0400 @@ -213,6 +213,7 @@ | CURRENT_TIMESTAMP | NE | LT | LE | GT | GE | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES + | JOIN | INNER | CROSS %nonterm file of decl list @@ -305,6 +306,7 @@ | query of exp | query1 of exp | tables of con list * exp + | fitem of con list * exp | tname of con | tnameW of con * con | tnames of (con * con) * (con * con) list @@ -359,6 +361,7 @@ %nonassoc DCOLON TCOLON %left UNION INTERSECT EXCEPT %right COMMA +%right JOIN INNER CROSS %right OR %right CAND %nonassoc EQ NE LT LE GT GE IS @@ -1422,17 +1425,50 @@ | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right))) | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right))) -tables : table' ([#1 table'], #2 table') - | table' COMMA tables (let - val loc = s (table'left, tablesright) +tables : fitem (fitem) + | fitem COMMA tables (let + val loc = s (fitemleft, tablesright) val e = (EVar (["Basis"], "sql_from_comma", Infer), loc) - val e = (EApp (e, #2 table'), loc) + val e = (EApp (e, #2 fitem), loc) in - (#1 table' :: #1 tables, + (#1 fitem @ #1 tables, (EApp (e, #2 tables), loc)) end) +fitem : table' ([#1 table'], #2 table') + | fitem JOIN fitem ON sqlexp (let + val loc = s (fitem1left, sqlexpright) + + val e = (EVar (["Basis"], "sql_inner_join", Infer), loc) + val e = (EApp (e, #2 fitem1), loc) + val e = (EApp (e, #2 fitem2), loc) + in + (#1 fitem1 @ #1 fitem2, + (EApp (e, sqlexp), loc)) + end) + | fitem INNER JOIN fitem ON sqlexp (let + val loc = s (fitem1left, sqlexpright) + + val e = (EVar (["Basis"], "sql_inner_join", Infer), loc) + val e = (EApp (e, #2 fitem1), loc) + val e = (EApp (e, #2 fitem2), loc) + in + (#1 fitem1 @ #1 fitem2, + (EApp (e, sqlexp), loc)) + end) + | fitem CROSS JOIN fitem (let + val loc = s (fitem1left, fitem2right) + + val e = (EVar (["Basis"], "sql_inner_join", Infer), loc) + val e = (EApp (e, #2 fitem1), loc) + val e = (EApp (e, #2 fitem2), loc) + val tru = sql_inject (EVar (["Basis"], "True", Infer), loc) + in + (#1 fitem1 @ #1 fitem2, + (EApp (e, tru), loc)) + end) + tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) | LBRACE cexp RBRACE (cexp)
--- a/src/urweb.lex Tue Apr 28 09:45:17 2009 -0400 +++ b/src/urweb.lex Tue Apr 28 10:11:56 2009 -0400 @@ -338,6 +338,10 @@ <INITIAL> "OFFSET" => (Tokens.OFFSET (pos yypos, pos yypos + size yytext)); <INITIAL> "ALL" => (Tokens.ALL (pos yypos, pos yypos + size yytext)); +<INITIAL> "JOIN" => (Tokens.JOIN (pos yypos, pos yypos + size yytext)); +<INITIAL> "INNER" => (Tokens.INNER (pos yypos, pos yypos + size yytext)); +<INITIAL> "CROSS" => (Tokens.CROSS (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));
--- a/tests/join.ur Tue Apr 28 09:45:17 2009 -0400 +++ b/tests/join.ur Tue Apr 28 10:11:56 2009 -0400 @@ -3,4 +3,6 @@ fun main () = r <- oneRow (SELECT * FROM t); r <- oneRow (SELECT * FROM t AS T1, t AS T2); + r <- oneRow (SELECT * FROM t AS T1 CROSS JOIN t AS T2); + r <- oneRow (SELECT * FROM t AS T1 JOIN t AS T2 ON T1.A = T2.A); return <xml/>