summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/ur/basis.urs5
-rw-r--r--src/elisp/urweb-mode.el3
-rw-r--r--src/monoize.sml16
-rw-r--r--src/urweb.grm46
-rw-r--r--src/urweb.lex4
-rw-r--r--tests/join.ur2
6 files changed, 70 insertions, 6 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index c6ba7b2c..a81ba30a 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -229,6 +229,11 @@ val sql_from_comma : tabs1 ::: {{Type}} -> tabs2 ::: {{Type}}
-> [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}}
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index 834c28da..2cd27fcc 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -149,7 +149,8 @@ See doc for the variable `urweb-mode-info'."
"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_']*\\>"
diff --git a/src/monoize.sml b/src/monoize.sml
index 8d8f07d4..98a32492 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1728,6 +1728,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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)
diff --git a/src/urweb.grm b/src/urweb.grm
index 21030b4d..723ed8b1 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -213,6 +213,7 @@ datatype attr = Class of exp | Normal of con * exp
| 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 @@ datatype attr = Class of exp | Normal of con * exp
| 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 @@ datatype attr = Class of exp | Normal of con * exp
%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 : SELECT select FROM tables wopt gopt hopt
| 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)
diff --git a/src/urweb.lex b/src/urweb.lex
index 534d51c6..c20e9206 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -338,6 +338,10 @@ notags = [^<{\n]+;
<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));
diff --git a/tests/join.ur b/tests/join.ur
index a883e45f..30a0e744 100644
--- a/tests/join.ur
+++ b/tests/join.ur
@@ -3,4 +3,6 @@ table t : { A : int }
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/>
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-17 19:08:03 +0000