Mercurial > urweb

changeset 234:82409ef72019

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
SELECTed expressions in ORDER BY
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 Aug 2008 11:49:38 -0400
parents c466678af854
children 0608a0cfd32a
files lib/basis.lig src/lacweb.grm tests/order_by.lac
diffstat 3 files changed, 46 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.lig	Thu Aug 28 11:17:14 2008 -0400
+++ b/lib/basis.lig	Thu Aug 28 11:49:38 2008 -0400
@@ -15,7 +15,7 @@
 
 con sql_query :: {{Type}} -> {Type} -> Type
 con sql_query1 :: {{Type}} -> {{Type}} -> {Type} -> Type
-con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type
+con sql_exp :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
 
 con sql_subset :: {{Type}} -> {{Type}} -> Type
 val sql_subset : keep_drop :: {({Type} * {Type})}
@@ -35,12 +35,12 @@
         -> selectedExps ::: {Type}
         -> {From : $(fold (fn nm => fn fields :: {Type} => fn acc =>
                 [nm] ~ acc => [nm = sql_table fields] ++ acc) [] tables),
-            Where : sql_exp tables [] bool,
+            Where : sql_exp tables [] [] bool,
             GroupBy : sql_subset tables grouped,
-            Having : sql_exp grouped tables bool,
+            Having : sql_exp grouped tables [] bool,
             SelectFields : sql_subset grouped selectedFields,
             SelectExps : $(fold (fn nm => fn t :: Type => fn acc =>
-                [nm] ~ acc => [nm = sql_exp grouped tables t] ++ acc) [] selectedExps) }
+                [nm] ~ acc => [nm = sql_exp grouped tables [] t] ++ acc) [] selectedExps) }
         -> sql_query1 tables selectedFields selectedExps
 
 type sql_relop 
@@ -60,11 +60,11 @@
 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
+con sql_order_by :: {{Type}} -> {Type} -> Type
+val sql_order_by_Nil : tables ::: {{Type}} -> exps :: {Type} -> sql_order_by tables exps
+val sql_order_by_Cons : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+        -> sql_exp tables [] exps t -> sql_order_by tables exps
+        -> sql_order_by tables exps
 
 type sql_limit
 val sql_no_limit : sql_limit
@@ -78,32 +78,39 @@
         -> selectedFields ::: {{Type}}
         -> selectedExps ::: {Type}
         -> {Rows : sql_query1 tables selectedFields selectedExps,
-            OrderBy : sql_order_by tables,
+            OrderBy : sql_order_by tables selectedExps,
             Limit : sql_limit,
             Offset : sql_offset}
         -> sql_query selectedFields selectedExps
 
 val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type -> agg ::: {{Type}}
+        -> exps ::: {Type}
         -> tab :: Name -> field :: Name
-        -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg fieldType
+        -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg exps fieldType
+
+val sql_exp : tabs ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> rest ::: {Type} -> nm :: Name
+        -> sql_exp tabs agg ([nm = t] ++ rest) t
 
 class sql_injectable
 val sql_bool : sql_injectable bool
 val sql_int : sql_injectable int
 val sql_float : sql_injectable float
 val sql_string : sql_injectable string
-val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables agg t
+val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+        -> sql_injectable t -> t -> sql_exp tables agg exps t
 
 con sql_unary :: Type -> Type -> Type
 val sql_not : sql_unary bool bool
-val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg ::: Type -> res ::: Type
-        -> sql_unary arg res -> sql_exp tables agg arg -> sql_exp tables agg res
+val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> arg ::: Type -> res ::: Type
+        -> sql_unary arg res -> sql_exp tables agg exps arg -> sql_exp tables agg exps res
 
 con sql_binary :: Type -> Type -> Type -> Type
 val sql_and : sql_binary bool bool bool
 val sql_or : sql_binary bool bool bool
-val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
-        -> sql_binary arg1 arg2 res -> sql_exp tables agg arg1 -> sql_exp tables agg arg2 -> sql_exp tables agg res
+val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+        -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
+        -> sql_binary arg1 arg2 res -> sql_exp tables agg exps arg1 -> sql_exp tables agg exps arg2
+        -> sql_exp tables agg exps res
 
 type sql_comparison
 val sql_eq : sql_comparison
@@ -113,8 +120,10 @@
 val sql_gt : sql_comparison
 val sql_ge : sql_comparison
 val sql_comparison : sql_comparison
-        -> tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> sql_exp tables agg t -> sql_exp tables agg t
-        -> sql_injectable t -> sql_exp tables agg bool
+        -> tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+        -> t ::: Type -> sql_injectable t
+        -> sql_exp tables agg exps t -> sql_exp tables agg exps t
+        -> sql_exp tables agg exps bool
 
 (** XML *)
 
--- a/src/lacweb.grm	Thu Aug 28 11:17:14 2008 -0400
+++ b/src/lacweb.grm	Thu Aug 28 11:49:38 2008 -0400
@@ -101,19 +101,19 @@
 
 fun sql_inject (v, t, loc) =
     let
-        val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (v, loc)), loc)
+        val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (t, loc)), loc)
     in
-        (EApp (e, (t, loc)), loc)
+        (EApp (e, (v, 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, (EWild, loc)), loc)
         val e = (EApp (e, sqlexp1), loc)
-        val e = (EApp (e, sqlexp2), loc)
     in
-        (EApp (e, (EWild, loc)), loc)
+        (EApp (e, sqlexp2), loc)
     end
 
 fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
@@ -801,6 +801,12 @@
                                          in
                                              (ECApp (e, fident), loc)
                                          end)
+       | CSYMBOL                         (let
+                                             val loc = s (CSYMBOLleft, CSYMBOLright)
+                                             val e = (EVar (["Basis"], "sql_exp"), loc)
+                                         in
+                                             (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                         end)
 
        | sqlexp EQ sqlexp               (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
        | sqlexp NE sqlexp               (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
@@ -837,7 +843,7 @@
        | HAVING sqlexp                  (sqlexp)
 
 obopt  :                                (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy),
-                                                (CWild (KRecord (KRecord (KType, dummy), dummy), dummy), dummy)),
+                                                (CWild (KRecord (KType, dummy), dummy), dummy)),
                                          dummy)
        | ORDER BY obexps                (obexps)
 
@@ -845,7 +851,7 @@
                                              val loc = s (sqlexpleft, sqlexpright)
 
                                              val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc),
-                                                              (CWild (KRecord (KRecord (KType, loc), loc), loc), loc)),
+                                                              (CWild (KRecord (KType, loc), loc), loc)),
                                                        loc)
                                              val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
                                                             sqlexp), loc)
--- a/tests/order_by.lac	Thu Aug 28 11:17:14 2008 -0400
+++ b/tests/order_by.lac	Thu Aug 28 11:49:38 2008 -0400
@@ -6,3 +6,10 @@
 val q3 = (SELECT t1.B FROM t1
         UNION SELECT t1.B FROM t1
         ORDER BY t1.B)
+
+val q4 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt
+        FROM t1, t2
+        ORDER BY Lt)
+val q5 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt
+        FROM t1, t2
+        ORDER BY t1.A, Lt, t2.D)