From 19f990b4515554027feacfc2b52c1f89f0521759 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 15 Apr 2010 08:48:41 -0400
Subject: Parsing ORDER BY

---
 src/iflow.sml | 31 ++++++++++++++++++++++---------
 1 file changed, 22 insertions(+), 9 deletions(-)

(limited to 'src/iflow.sml')

diff --git a/src/iflow.sml b/src/iflow.sml
index df41ad80..06566523 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -952,6 +952,7 @@ datatype Rel =
 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 @@ fun sqexp chs =
     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 @@ datatype sitem =
          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 @@ datatype query =
          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 @@ fun expIn rv env rvOf =
                 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 @@ fun doQuery (arg : 'a doQuery) e =
                                 case e of
                                     SqConst _ => []
                                   | Field (v, f) => [(v, f)]
+                                  | Computed _ => []
                                   | Binop (_, e1, e2) => removeDups (usedFields e1 @ usedFields e2)
                                   | SqKnown _ => []
                                   | Inj _ => []
-- 
cgit v1.2.3