summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Karn Kallio <kkallio@eka>2011-11-23 12:17:40 -0530
committerGravatar Karn Kallio <kkallio@eka>2011-11-23 12:17:40 -0530
commit4f189ee576e925733c1ffc6c483cb95cf0711170 (patch)
tree50be5eee01b33287ce0f9d137f9fd2dded507ed6
parente9dcc580d0cb1222ef3889e6f536953724857c3d (diff)
Add LIKE operator to SQL sublanguage.
-rw-r--r--lib/ur/basis.urs2
-rw-r--r--src/elisp/urweb-mode.el2
-rw-r--r--src/monoize.sml3
-rw-r--r--src/urweb.grm4
-rw-r--r--src/urweb.lex1
5 files changed, 10 insertions, 2 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index f21faf38..fcce3a01 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -523,6 +523,8 @@ val sql_le : t ::: Type -> sql_binary t t bool
val sql_gt : t ::: Type -> sql_binary t t bool
val sql_ge : t ::: Type -> sql_binary t t bool
+val sql_like : sql_binary string string bool
+
val sql_count : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
-> sql_exp tables agg exps int
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index f56834b2..b5c42cbe 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -151,7 +151,7 @@ See doc for the variable `urweb-mode-info'."
"PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK"
"FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL"
"JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1"
- "IF" "THEN" "ELSE")
+ "IF" "THEN" "ELSE" "COALESCE" "LIKE")
"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 d18b4d2a..4a70c012 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2470,6 +2470,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| L.EFfi ("Basis", "sql_mod") =>
((L'.EPrim (Prim.String "%"), loc), fm)
+ | L.EFfi ("Basis", "sql_like") =>
+ ((L'.EPrim (Prim.String "LIKE"), loc), fm)
+
| L.ECApp (
(L.ECApp (
(L.ECApp (
diff --git a/src/urweb.grm b/src/urweb.grm
index 8e3fad90..bb9ea18b 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -244,7 +244,7 @@ fun tnamesOf (e, _) =
| TRUE | FALSE | CAND | OR | NOT
| COUNT | AVG | SUM | MIN | MAX
| ASC | DESC
- | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS | COALESCE
+ | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS | COALESCE | LIKE
| CURRENT_TIMESTAMP
| NE | LT | LE | GT | GE
| CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
@@ -1834,6 +1834,8 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In
| sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
| sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+ | sqlexp LIKE sqlexp (sql_binary ("like", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
| NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
| MINUS sqlexp (sql_unary ("neg", sqlexp, s (MINUSleft, sqlexpright)))
diff --git a/src/urweb.lex b/src/urweb.lex
index 8e8b0a12..b3b590f2 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -500,6 +500,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
<INITIAL> "NULL" => (Tokens.NULL (pos yypos, pos yypos + size yytext));
<INITIAL> "IS" => (Tokens.IS (pos yypos, pos yypos + size yytext));
<INITIAL> "COALESCE" => (Tokens.COALESCE (pos yypos, pos yypos + size yytext));
+<INITIAL> "LIKE" => (Tokens.LIKE (pos yypos, pos yypos + size yytext));
<INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
<INITIAL> "UNIQUE" => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));