Mercurial > urweb
diff src/iflow.sml @ 1239:30f789d5e2ad
Parsing ORDER BY
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 15 Apr 2010 08:48:41 -0400 |
| parents | d6938ab3b5ae |
| children | 58f5ac1bb849 |
line wrap: on
line diff
--- a/src/iflow.sml Wed Apr 14 09:18:16 2010 -0400 +++ b/src/iflow.sml Thu Apr 15 08:48:41 2010 -0400 @@ -952,6 +952,7 @@ datatype sqexp = SqConst of Prim.t | Field of string * string + | Computed of string | Binop of Rel * sqexp * sqexp | SqKnown of sqexp | Inj of Mono.exp @@ -1034,6 +1035,7 @@ log "sqexp" (altL [wrap prim SqConst, wrap field Field, + wrap uw_ident Computed, wrap known SqKnown, wrap func SqFunc, wrap (const "COUNT(*)") (fn () => Count), @@ -1068,9 +1070,9 @@ SqField of string * string | SqExp of sqexp * string -val sitem = alt (wrap field SqField) - (wrap (follow sqexp (follow (const " AS ") uw_ident)) - (fn (e, ((), s)) => SqExp (e, s))) +val sitem = alt (wrap (follow sqexp (follow (const " AS ") uw_ident)) + (fn (e, ((), s)) => SqExp (e, s))) + (wrap field SqField) val select = log "select" (wrap (follow (const "SELECT ") (list sitem)) @@ -1100,13 +1102,22 @@ Query1 of query1 | Union of query * query +val orderby = log "orderby" + (wrap (follow (ws (const "ORDER BY ")) + (list sqexp)) + ignore) + fun query chs = log "query" - (alt (wrap (follow (const "((") - (follow query - (follow (const ") UNION (") - (follow query (const "))"))))) - (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2))) - (wrap query1 Query1)) + (wrap + (follow + (alt (wrap (follow (const "((") + (follow query + (follow (const ") UNION (") + (follow query (const "))"))))) + (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2))) + (wrap query1 Query1)) + (opt orderby)) + #1) chs datatype dml = @@ -1455,6 +1466,7 @@ case e of SqConst p => inl (Const p) | Field (v, f) => inl (Proj (rvOf v, f)) + | Computed _ => default () | Binop (bo, e1, e2) => let val e1 = expIn e1 @@ -1567,6 +1579,7 @@ case e of SqConst _ => [] | Field (v, f) => [(v, f)] + | Computed _ => [] | Binop (_, e1, e2) => removeDups (usedFields e1 @ usedFields e2) | SqKnown _ => [] | Inj _ => []