diff options
| -rw-r--r-- | lib/basis.lig | 10 | ||||
| -rw-r--r-- | src/lacweb.grm | 21 | ||||
| -rw-r--r-- | src/lacweb.lex | 5 | ||||
| -rw-r--r-- | src/source_print.sml | 2 | ||||
| -rw-r--r-- | tests/where.lac | 2 |
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"}) |