summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/basis.lig10
-rw-r--r--src/lacweb.grm21
-rw-r--r--src/lacweb.lex5
-rw-r--r--src/source_print.sml2
-rw-r--r--tests/where.lac2
5 files changed, 38 insertions, 2 deletions
diff --git a/lib/basis.lig b/lib/basis.lig
index 01b3fab8..1343e449 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -34,6 +34,16 @@ val sql_string : sql_type string
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 *)
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 4f316d74..037f8d92 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -79,6 +79,16 @@ fun sql_inject (v, t, loc) =
(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 @@ fun sql_inject (v, t, loc) =
| 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 @@ fun sql_inject (v, t, loc) =
| SELECT | FROM | AS | CWHERE
| TRUE | FALSE
+ | NE | LT | LE | GT | GE
%nonterm
file of decl list
@@ -192,6 +203,7 @@ fun sql_inject (v, t, loc) =
%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 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"),
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)))
diff --git a/src/lacweb.lex b/src/lacweb.lex
index 3d745bf2..e71974f6 100644
--- a/src/lacweb.lex
+++ b/src/lacweb.lex
@@ -238,6 +238,11 @@ notags = [^<{\n]+;
<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));
diff --git a/src/source_print.sml b/src/source_print.sml
index 6aaeb402..08231ab5 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -286,7 +286,7 @@ fun p_exp' par (e, _) =
space,
p_exp e]) pes])
- | ESqlInfer => string "<sql-infer>"
+ | EWild => string "_"
and p_exp e = p_exp' false e
diff --git a/tests/where.lac b/tests/where.lac
index c7bd6167..7152a62b 100644
--- a/tests/where.lac
+++ b/tests/where.lac
@@ -5,3 +5,5 @@ val q1 = (SELECT * FROM t1)
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"})