changeset 219:5292c0113024

SQL comparison operators
author Adam Chlipala <adamc@hcoop.net>
date Sat, 16 Aug 2008 17:18:00 -0400
parents a3413288cce1
children 2b665e822e9a
files lib/basis.lig src/lacweb.grm src/lacweb.lex src/source_print.sml tests/where.lac
diffstat 5 files changed, 38 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.lig	Sat Aug 16 16:57:21 2008 -0400
+++ b/lib/basis.lig	Sat Aug 16 17:18:00 2008 -0400
@@ -34,6 +34,16 @@
 
 val sql_inject : tables ::: {{Type}} -> t ::: Type -> t -> sql_type t -> sql_exp tables t
 
+type sql_comparison
+val sql_eq : sql_comparison
+val sql_ne : sql_comparison
+val sql_lt : sql_comparison
+val sql_le : sql_comparison
+val sql_gt : sql_comparison
+val sql_ge : sql_comparison
+val sql_comparison : sql_comparison
+        -> tables ::: {{Type}} -> t ::: Type -> sql_exp tables t -> sql_exp tables t
+        -> sql_type t -> sql_exp tables bool
 
 (** XML *)
 
--- a/src/lacweb.grm	Sat Aug 16 16:57:21 2008 -0400
+++ b/src/lacweb.grm	Sat Aug 16 17:18:00 2008 -0400
@@ -79,6 +79,16 @@
         (EApp (e, (t, loc)), loc)
     end
 
+fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_comparison"), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+        val e = (EApp (e, sqlexp2), loc)
+    in
+                (EApp (e, (EWild, loc)), loc)
+    end
+
 %%
 %header (functor LacwebLrValsFn(structure Token : TOKEN))
 
@@ -88,7 +98,7 @@
  | SYMBOL of string | CSYMBOL of string
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
- | DIVIDE | GT | DOTDOTDOT
+ | DIVIDE | DOTDOTDOT
  | CON | LTYPE | VAL | REC | AND | FOLD | UNIT | KUNIT | CLASS
  | DATATYPE | OF
  | TYPE | NAME
@@ -104,6 +114,7 @@
 
  | SELECT | FROM | AS | CWHERE
  | TRUE | FALSE
+ | NE | LT | LE | GT | GE
 
 %nonterm
    file of decl list
@@ -192,6 +203,7 @@
 %nonassoc COLON
 %nonassoc DCOLON TCOLON
 %right COMMA
+%nonassoc EQ NE LT LE GT GE
 %right ARROW LARROW
 %right PLUSPLUS MINUSMINUS
 %right STAR
@@ -651,6 +663,13 @@
                                                      EVar (["Basis"], "sql_bool"),
                                                      s (FALSEleft, FALSEright)))
 
+       | sqlexp EQ sqlexp               (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp NE sqlexp               (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LT sqlexp               (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LE sqlexp               (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GT sqlexp               (sql_compare ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GE sqlexp               (sql_compare ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
        | LBRACE eexp RBRACE             (sql_inject (#1 eexp,
                                                      EWild,
                                                      s (LBRACEleft, RBRACEright)))
--- a/src/lacweb.lex	Sat Aug 16 16:57:21 2008 -0400
+++ b/src/lacweb.lex	Sat Aug 16 17:18:00 2008 -0400
@@ -238,6 +238,11 @@
 <INITIAL> "--"        => (Tokens.MINUSMINUS (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "="         => (Tokens.EQ (pos yypos, pos yypos + size yytext));
+<INITIAL> "<>"        => (Tokens.NE (pos yypos, pos yypos + size yytext));
+<INITIAL> "<"         => (Tokens.LT (pos yypos, pos yypos + size yytext));
+<INITIAL> ">"         => (Tokens.GT (pos yypos, pos yypos + size yytext));
+<INITIAL> "<="        => (Tokens.LE (pos yypos, pos yypos + size yytext));
+<INITIAL> ">="        => (Tokens.GE (pos yypos, pos yypos + size yytext));
 <INITIAL> ","         => (Tokens.COMMA (pos yypos, pos yypos + size yytext));
 <INITIAL> ":::"       => (Tokens.TCOLON (pos yypos, pos yypos + size yytext));
 <INITIAL> "::"        => (Tokens.DCOLON (pos yypos, pos yypos + size yytext));
--- a/src/source_print.sml	Sat Aug 16 16:57:21 2008 -0400
+++ b/src/source_print.sml	Sat Aug 16 17:18:00 2008 -0400
@@ -286,7 +286,7 @@
                                                                space,
                                                                p_exp e]) pes])
 
-      | ESqlInfer => string "<sql-infer>"
+      | EWild => string "_"
 
 and p_exp e = p_exp' false e
 
--- a/tests/where.lac	Sat Aug 16 16:57:21 2008 -0400
+++ b/tests/where.lac	Sat Aug 16 17:18:00 2008 -0400
@@ -5,3 +5,5 @@
 val q2 = (SELECT * FROM t1 WHERE TRUE)
 val q3 = (SELECT * FROM t1 WHERE FALSE)
 val q4 = (SELECT * FROM t1 WHERE {True})
+val q5 = (SELECT * FROM t1 WHERE {1} = {1})
+val q6 = (SELECT * FROM t1 WHERE {"Hi"} < {"Bye"})