INNER JOIN

4 files changed, 63 insertions, 6 deletions

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));