Mercurial > urweb
diff src/monoize.sml @ 1682:ac141fbb313a
'ORDER BY RANDOM' (based on a patch from Ron de Bruijn)
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 02 Feb 2012 11:40:10 -0500 |
parents | 5b2c7b9f6017 |
children | a7b70c7b3f1a |
line wrap: on
line diff
--- a/src/monoize.sml Sun Jan 22 20:25:14 2012 -0500 +++ b/src/monoize.sml Thu Feb 02 11:40:10 2012 -0500 @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -74,7 +74,7 @@ SM.insert (fs', x, n))) ([], SM.empty) (r, fs) in pvars := RM.insert (!pvars, r', (n, fs)); - pvarDefs := (L'.DDatatype [("$poly" ^ Int.toString n, n, map (fn (x, n, t) => (x, n, SOME t)) fs)], loc) + pvarDefs := (L'.DDatatype [("$poly" ^ Int.toString n, n, map (fn (x, n, t) => (x, n, SOME t)) fs)], loc) :: !pvarDefs; pvarOldDefs := (n, r) :: !pvarOldDefs; (n, fs) @@ -312,9 +312,9 @@ let val r = ref (L'.Default, []) val (_, xs, xncs) = Env.lookupDatatype env n - + val dtmap' = IM.insert (dtmap, n, r) - + val xncs = map (fn (x, n, to) => (x, n, Option.map (mt env dtmap') to)) xncs in case xs of @@ -580,7 +580,7 @@ result = ran}), loc)), loc), "")], loc), fm) - end + end val (fm, n) = Fm.lookup fm fk i makeDecl in @@ -594,7 +594,7 @@ ((L'.ECase (e, [((L'.PNone t, loc), (L'.EPrim (Prim.String "None"), loc)), - + ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc), (L'.EStrcat ((L'.EPrim (Prim.String "Some/"), loc), body), loc))], @@ -1186,7 +1186,7 @@ ((L'.EAbs ("f", dom, dom, (L'.ERel 0, loc)), loc), fm) end - + | L.ECApp ((L.EFfi ("Basis", "show"), _), t) => let val t = monoType env t @@ -2059,7 +2059,7 @@ strcat [sc " WHERE ", gf "Where"])], {disc = s, result = s}), loc), - + if List.all (fn (x, xts) => case List.find (fn (x', _) => x' = x) grouped of NONE => List.null xts @@ -2194,7 +2194,7 @@ | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_subset_concat"), _), _), _), _), _), _), _), _) => let - val un = (L'.TRecord [], loc) + val un = (L'.TRecord [], loc) in ((L'.EAbs ("_", un, (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, @@ -2406,6 +2406,8 @@ | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => ((L'.EPrim (Prim.String ""), loc), fm) + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_random"), _), _), _), _) => + ((L'.EPrim (Prim.String (#randomFunction (Settings.currentDbms ()) ^ "()")), loc), fm) | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -2755,7 +2757,6 @@ | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm) | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm) - | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -2763,7 +2764,7 @@ (L.EFfi ("Basis", "sql_nfunc"), _), _), _), _), _), - _), _), + _), _), _) => let val s = (L'.TFfi ("Basis", "string"), loc) @@ -2893,7 +2894,7 @@ (L'.ERel 0, loc)), loc)), loc), fm) end - + | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -3045,7 +3046,7 @@ | ("Onload", e, _) :: rest => findOnload (rest, SOME e, onunload, acc) | ("Onunload", e, _) :: rest => findOnload (rest, onload, SOME e, acc) | x :: rest => findOnload (rest, onload, onunload, x :: acc) - + val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, []) val (class, fm) = monoExp (env, st, fm) class @@ -3325,7 +3326,7 @@ List.exists (fn ((L.CName tag', _), _) => tag' = tag | _ => false) ctx | _ => false - + val tag = if inTag "Tr" then "tr" else if inTag "Table" then @@ -3343,7 +3344,7 @@ fm) | _ => raise Fail "Monoize: Bad dyn attributes" end - + | "submit" => normal ("input type=\"submit\"", NONE, NONE) | "image" => normal ("input type=\"image\"", NONE, NONE) | "button" => normal ("input type=\"submit\"", NONE, NONE) @@ -4312,7 +4313,7 @@ let val (nExp, fm) = Fm.freshName fm val (nIni, fm) = Fm.freshName fm - + val dExp = L'.DVal ("expunger", nExp, (L'.TFun (client, unit), loc),