diff options
| -rw-r--r-- | lib/ur/basis.urs | 7 | ||||
| -rw-r--r-- | src/elisp/urweb-mode.el | 3 | ||||
| -rw-r--r-- | src/monoize.sml | 25 | ||||
| -rw-r--r-- | src/urweb.grm | 8 | ||||
| -rw-r--r-- | src/urweb.lex | 4 |
5 files changed, 46 insertions, 1 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 70c1ef55..73ee8e2b 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -474,6 +474,13 @@ val sql_is_null : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> sql_exp tables agg exps (option t) -> sql_exp tables agg exps bool +val sql_if_then_else : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} + -> t ::: Type + -> sql_exp tables agg exps bool + -> sql_exp tables agg exps t + -> sql_exp tables agg exps t + -> sql_exp tables agg exps t + class sql_arith val sql_arith_int : sql_arith int val sql_arith_float : sql_arith float diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el index b9ffaf10..f56834b2 100644 --- a/src/elisp/urweb-mode.el +++ b/src/elisp/urweb-mode.el @@ -150,7 +150,8 @@ See doc for the variable `urweb-mode-info'." "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE" "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK" "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL" - "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1") + "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1" + "IF" "THEN" "ELSE") "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 417bf044..e33513f8 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2804,6 +2804,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end + | (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_if_then_else"), _), _), + _), _), + _), _), + _), _)) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + in + ((L'.EAbs ("if", s, (L'.TFun (s, s), loc), + (L'.EAbs ("then", s, (L'.TFun (s, s), loc), + (L'.EAbs ("else", s, (L'.TFun (s, s), loc), + strcat [sc "(CASE WHEN (", + (L'.ERel 2, loc), + sc ") THEN (", + (L'.ERel 1, loc), + sc ") ELSE (", + (L'.ERel 0, loc), + sc ") END)"]), loc)), loc)), loc), + fm) + end + | L.ECApp ( (L.ECApp ( (L.ECApp ( diff --git a/src/urweb.grm b/src/urweb.grm index db99d3b5..d39fbe55 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -249,6 +249,7 @@ fun tnamesOf (e, _) = | NE | LT | LE | GT | GE | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL + | CIF | CTHEN | CELSE %nonterm file of decl list @@ -1828,6 +1829,13 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In sqlexp), loc) end) + | CIF sqlexp CTHEN sqlexp CELSE sqlexp (let + val loc = s (CIFleft, sqlexp3right) + val e = (EVar (["Basis"], "sql_if_then_else", Infer), loc) + in + (EApp ((EApp ((EApp (e, sqlexp1), loc), sqlexp2), loc), sqlexp3), loc) + end) + | LBRACE LBRACK eexp RBRACK RBRACE (sql_inject (#1 eexp, s (LBRACEleft, RBRACEright))) | LPAREN sqlexp RPAREN (sqlexp) diff --git a/src/urweb.lex b/src/urweb.lex index 74b91432..21e3d603 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -480,6 +480,10 @@ xint = x[0-9a-fA-F][0-9a-fA-F]; <INITIAL> "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext)); <INITIAL> "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext)); +<INITIAL> "IF" => (Tokens.CIF (pos yypos, pos yypos + size yytext)); +<INITIAL> "THEN" => (Tokens.CTHEN (pos yypos, pos yypos + size yytext)); +<INITIAL> "ELSE" => (Tokens.CELSE (pos yypos, pos yypos + size yytext)); + <INITIAL> "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext)); <INITIAL> "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext)); |