summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-08-21 15:50:08 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-08-21 15:50:08 -0400
commit5334dee9b387e718de785ee8578219d854755002 (patch)
treecd0e5c20b73eb9b4feaaadd4d1e98cc3fdd2f915
parent7a98ce3ccaa8e808bcbfc166eda9c9350776fabd (diff)
ORDER BY
-rw-r--r--lib/basis.lig13
-rw-r--r--src/lacweb.grm43
-rw-r--r--src/lacweb.lex1
-rw-r--r--tests/order_by.lac8
4 files changed, 59 insertions, 6 deletions
diff --git a/lib/basis.lig b/lib/basis.lig
index 6ef7408f..863debcb 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -50,9 +50,20 @@ val sql_relop : sql_relop
-> selected ::: {{Type}}
-> sql_query1 tables1 selected -> sql_query1 tables2 selected -> sql_query1 selected selected
+type sql_direction
+val sql_asc : sql_direction
+val sql_desc : sql_direction
+
+con sql_order_by :: {{Type}} -> Type
+val sql_order_by_Nil : tables :: {{Type}} -> sql_order_by tables
+val sql_order_by_Cons : tables ::: {{Type}} -> t ::: Type
+ -> sql_exp tables [] t -> sql_order_by tables
+ -> sql_order_by tables
+
val sql_query : tables ::: {{Type}}
-> selected ::: {{Type}}
- -> sql_query1 tables selected
+ -> {Rows : sql_query1 tables selected,
+ OrderBy : sql_order_by tables}
-> sql_query selected
val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type -> agg ::: {{Type}}
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 8bbc935a..b4256f30 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -30,6 +30,7 @@
open Source
val s = ErrorMsg.spanOf
+val dummy = ErrorMsg.dummySpan
fun capitalize "" = ""
| capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
@@ -161,7 +162,7 @@ fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
| NOTAGS of string
| BEGIN_TAG of string | END_TAG of string
- | SELECT | FROM | AS | CWHERE | GROUP | BY | HAVING
+ | SELECT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
| UNION | INTERSECT | EXCEPT
| TRUE | FALSE | CAND | OR | NOT
| NE | LT | LE | GT | GE
@@ -242,6 +243,8 @@ fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
| groupis of group_item list
| gopt of group_item list option
| hopt of exp
+ | obopt of exp
+ | obexps of exp
%verbose (* print summary of errors *)
@@ -655,10 +658,15 @@ attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTri
| STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
| LBRACE eexp RBRACE (eexp)
-query : query1 (let
+query : query1 obopt (let
val loc = s (query1left, query1right)
+
+ val re = (ERecord [((CName "Rows", loc),
+ query1),
+ ((CName "OrderBy", loc),
+ obopt)], loc)
in
- (EApp ((EVar (["Basis"], "sql_query"), loc), query1), loc)
+ (EApp ((EVar (["Basis"], "sql_query"), loc), re), loc)
end)
query1 : SELECT select FROM tables wopt gopt hopt
@@ -796,7 +804,7 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"),
wopt : (sql_inject (EVar (["Basis"], "True"),
EVar (["Basis"], "sql_bool"),
- ErrorMsg.dummySpan))
+ dummy))
| CWHERE sqlexp (sqlexp)
groupi : tident DOT fident (GField (tident, fident))
@@ -809,5 +817,30 @@ gopt : (NONE)
hopt : (sql_inject (EVar (["Basis"], "True"),
EVar (["Basis"], "sql_bool"),
- ErrorMsg.dummySpan))
+ dummy))
| HAVING sqlexp (sqlexp)
+
+obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy),
+ (CWild (KRecord (KRecord (KType, dummy), dummy), dummy), dummy)),
+ dummy)
+ | ORDER BY obexps (obexps)
+
+obexps : sqlexp (let
+ val loc = s (sqlexpleft, sqlexpright)
+
+ val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc),
+ (CWild (KRecord (KRecord (KType, loc), loc), loc), loc)),
+ loc)
+ val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
+ sqlexp), loc)
+ in
+ (EApp (e, e'), loc)
+ end)
+ | sqlexp COMMA obexps (let
+ val loc = s (sqlexpleft, obexpsright)
+
+ val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
+ sqlexp), loc)
+ in
+ (EApp (e, obexps), loc)
+ end)
diff --git a/src/lacweb.lex b/src/lacweb.lex
index cd4e75f4..5c87ae17 100644
--- a/src/lacweb.lex
+++ b/src/lacweb.lex
@@ -306,6 +306,7 @@ notags = [^<{\n]+;
<INITIAL> "AS" => (Tokens.AS (pos yypos, pos yypos + size yytext));
<INITIAL> "WHERE" => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));
<INITIAL> "GROUP" => (Tokens.GROUP (pos yypos, pos yypos + size yytext));
+<INITIAL> "ORDER" => (Tokens.ORDER (pos yypos, pos yypos + size yytext));
<INITIAL> "BY" => (Tokens.BY (pos yypos, pos yypos + size yytext));
<INITIAL> "HAVING" => (Tokens.HAVING (pos yypos, pos yypos + size yytext));
diff --git a/tests/order_by.lac b/tests/order_by.lac
new file mode 100644
index 00000000..77dfa541
--- /dev/null
+++ b/tests/order_by.lac
@@ -0,0 +1,8 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1 ORDER BY t1.A, t1.B)
+val q2 = (SELECT * FROM t1 GROUP BY t1.A ORDER BY t1.A, t1.B)
+val q3 = (SELECT t1.B FROM t1
+ UNION SELECT t1.B FROM t1
+ ORDER BY t1.B)