diff options
author | 2008-08-31 16:03:43 -0400 | |
---|---|---|
committer | 2008-08-31 16:03:43 -0400 | |
commit | 578034280bdf2b7172e71b3f36b6db6db3ce53eb (patch) | |
tree | 73facc99e21a2bc100176cc5b210a3a152eefe1c | |
parent | 003594fd2ed4739b9f1fdc8df350615fdc11a3f7 (diff) |
Monoize ORDER BY
-rw-r--r-- | src/monoize.sml | 49 | ||||
-rw-r--r-- | tests/order_by.ur | 22 |
2 files changed, 68 insertions, 3 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index c9bec0c5..d2da6e27 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -555,7 +555,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.TRecord [("Rows", s), ("OrderBy", s), ("Limit", s), ("Offset", s)], loc), s, strcat loc [gf "Rows", - gf "OrderBy", + (L'.ECase (gf "OrderBy", + [((L'.PPrim (Prim.String ""), loc), sc ""), + ((L'.PWild, loc), + strcat loc [sc " ORDER BY ", + gf "OrderBy"])], + {disc = s, result = s}), loc), gf "Limit", gf "Offset"]), loc), fm) end @@ -612,7 +617,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) = loc), s, strcat loc [sc "SELECT ", - strcatR loc (gf "SelectExps") sexps, + strcatComma loc (map (fn (x, t) => + strcat loc [ + (L'.EField (gf "SelectExps", x), loc), + sc (" AS _" ^ x) + ]) sexps), case sexps of [] => sc "" | _ => sc ", ", @@ -703,6 +712,30 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => ((L'.EPrim (Prim.String ""), loc), fm) + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_order_by_Cons"), _), + _), _), + _), _), + _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + in + ((L'.EAbs ("e1", s, (L'.TFun (s, s), loc), + (L'.EAbs ("e2", s, s, + (L'.ECase ((L'.ERel 0, loc), + [((L'.PPrim (Prim.String ""), loc), + (L'.ERel 1, loc)), + ((L'.PWild, loc), + strcat loc [(L'.ERel 1, loc), + sc ", ", + (L'.ERel 0, loc), + sc ")"])], + {disc = s, result = s}), loc)), loc)), loc), + fm) + end | L.EFfi ("Basis", "sql_no_limit") => ((L'.EPrim (Prim.String ""), loc), fm) @@ -800,6 +833,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_exp"), _), + _), _), + _), _), + _), _), + _), _), + (L.CName nm, _)) => ((L'.EPrim (Prim.String ("_" ^ nm)), loc), fm) + + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( (L.EFfi ("Basis", "sql_relop"), _), _), _), _), _), diff --git a/tests/order_by.ur b/tests/order_by.ur index f2b501c4..dbe041c2 100644 --- a/tests/order_by.ur +++ b/tests/order_by.ur @@ -10,6 +10,26 @@ val q3 = (SELECT t1.B FROM t1 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 +val q5 = (SELECT t1.A, t1.B, t2.D, t1.A < t2.D AS Lt FROM t1, t2 ORDER BY t1.A, Lt, t2.D) + + +datatype list a = Nil | Cons of a * list a + +val r1 : transaction (list string) = + query q5 + (fn fs acc => return (Cons (fs.T1.B, acc))) + Nil + +val r2 : transaction string = + ls <- r1; + return (case ls of + Nil => "Problem" + | Cons (b, _) => b) + +val main : unit -> transaction page = fn () => + s <- r2; + return <html><body> + {cdata s} + </body></html> |