From bce3a31c8040f437fcb1d0a3e0440259ed851a9d Mon Sep 17 00:00:00 2001
From: Karn Kallio <kkallio@eka>
Date: Wed, 23 Nov 2011 12:17:40 -0530
Subject: Add LIKE operator to SQL sublanguage.

---
 lib/ur/basis.urs        | 2 ++
 src/elisp/urweb-mode.el | 2 +-
 src/monoize.sml         | 3 +++
 src/urweb.grm           | 4 +++-
 src/urweb.lex           | 1 +
 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));
-- 
cgit v1.2.3