summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/ur/basis.urs7
-rw-r--r--src/elisp/urweb-mode.el3
-rw-r--r--src/monoize.sml25
-rw-r--r--src/urweb.grm8
-rw-r--r--src/urweb.lex4
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));