diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-06-02 16:47:09 -0400 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-06-02 16:47:09 -0400 |
commit | ecb92d9539880cc59a371c786af5312b833ff8ca (patch) | |
tree | 16d85bb575a9248e5c830e757a822240f8fa04ff /src | |
parent | 6f28076613c975e382014cbcb074cbaa22fdf3e3 (diff) |
Partitioning and ordering for window functions
Diffstat (limited to 'src')
-rw-r--r-- | src/monoize.sml | 56 | ||||
-rw-r--r-- | src/mysql.sml | 3 | ||||
-rw-r--r-- | src/postgres.sml | 3 | ||||
-rw-r--r-- | src/settings.sig | 3 | ||||
-rw-r--r-- | src/settings.sml | 6 | ||||
-rw-r--r-- | src/sqlite.sml | 3 | ||||
-rw-r--r-- | src/urweb.grm | 35 |
7 files changed, 90 insertions, 19 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 1a70894f..8224b26f 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -299,6 +299,8 @@ fun monoType env = (L'.TRecord [], loc) | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) => (L'.TRecord [], loc) + | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_partition"), _), _), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window"), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "sql_arith"), _), _) => @@ -2744,10 +2746,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), (L'.ERecord [], loc)), loc), fm) - | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _), _), _) => - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc), - (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "AVG"), loc)), loc)), loc), + | L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) => + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), + (L'.EPrim (Prim.String "AVG"), loc)), loc), fm) | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_sum"), _), _), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc), @@ -2783,6 +2784,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ( (L.ECApp ( (L.ECApp ( + (L.EFfi ("Basis", "sql_no_partition"), _), + _), _), + _), _), + _) => ((L'.EPrim (Prim.String ""), loc), fm) + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_partition"), _), + _), _), + _), _), + _), _), + _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("e", s, s, strcat [(L'.EPrim (Prim.String "PARTITION BY "), loc), (L'.ERel 0, loc)]), loc), + fm) + end + + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( (L.ECApp ( (L.EFfi ("Basis", "sql_window"), _), _), _), @@ -2790,13 +2814,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _), _), _) => let + val () = if #windowFunctions (Settings.currentDbms ()) then + () + else + ErrorMsg.errorAt loc "The DBMS you've selected doesn't support window functions." + val s = (L'.TFfi ("Basis", "string"), loc) fun sc s = (L'.EPrim (Prim.String s), loc) - val main = strcat [(L'.ERel 0, loc), - sc " OVER ()"] + val main = strcat [(L'.ERel 2, loc), + sc " OVER (", + (L'.ERel 1, loc), + (L'.ECase ((L'.ERel 0, loc), + [((L'.PPrim (Prim.String ""), loc), + sc ""), + ((L'.PWild, loc), + strcat [sc " ORDER BY ", + (L'.ERel 0, loc)])], + {disc = s, + result = s}), loc), + sc ")"] in - ((L'.EAbs ("w", s, s, main), loc), + ((L'.EAbs ("w", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), + (L'.EAbs ("p", s, (L'.TFun (s, s), loc), + (L'.EAbs ("o", s, s, + main), loc)), loc)), loc), fm) end diff --git a/src/mysql.sml b/src/mysql.sml index 780f5148..1a641d57 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -1554,6 +1554,7 @@ val () = addDbms {name = "mysql", trueString = "TRUE", falseString = "FALSE", onlyUnion = true, - nestedRelops = false} + nestedRelops = false, + windowFunctions = false} end diff --git a/src/postgres.sml b/src/postgres.sml index db9c9d3a..e555c565 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -1063,7 +1063,8 @@ val () = addDbms {name = "postgres", trueString = "TRUE", falseString = "FALSE", onlyUnion = false, - nestedRelops = true} + nestedRelops = true, + windowFunctions = true} val () = setDbms "postgres" diff --git a/src/settings.sig b/src/settings.sig index 7140c645..a9ad36a5 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -199,7 +199,8 @@ signature SETTINGS = sig trueString : string, falseString : string, onlyUnion : bool, - nestedRelops : bool + nestedRelops : bool, + windowFunctions : bool } val addDbms : dbms -> unit diff --git a/src/settings.sml b/src/settings.sml index 246be88b..3b89ce46 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -537,7 +537,8 @@ type dbms = { trueString : string, falseString : string, onlyUnion : bool, - nestedRelops : bool + nestedRelops : bool, + windowFunctions : bool } val dbmses = ref ([] : dbms list) @@ -568,7 +569,8 @@ val curDb = ref ({name = "", trueString = "", falseString = "", onlyUnion = false, - nestedRelops = false} : dbms) + nestedRelops = false, + windowFunctions = false} : dbms) fun addDbms v = dbmses := v :: !dbmses fun setDbms s = diff --git a/src/sqlite.sml b/src/sqlite.sml index f7d8f824..0f83c967 100644 --- a/src/sqlite.sml +++ b/src/sqlite.sml @@ -846,6 +846,7 @@ val () = addDbms {name = "sqlite", trueString = "1", falseString = "0", onlyUnion = false, - nestedRelops = false} + nestedRelops = false, + windowFunctions = false} end diff --git a/src/urweb.grm b/src/urweb.grm index 831ec4a8..eec8f8c1 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -303,6 +303,19 @@ fun parseStyle s pos = foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "oneProperty", Infer), pos), e), pos), parseProperty s pos), pos)) (EVar (["Basis"], "noStyle", Infer), pos) props +fun applyWindow loc e window = + let + val (pb, ob) = getOpt (window, ((EVar (["Basis"], "sql_no_partition", Infer), dummy), + (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), dummy), + (CWild (KRecord (KType, dummy), dummy), dummy)), + dummy))) + val e' = (EVar (["Basis"], "sql_window", Infer), loc) + val e' = (EApp (e', e), loc) + val e' = (EApp (e', pb), loc) + in + (EApp (e', ob), loc) + end + %% %header (functor UrwebLrValsFn(structure Token : TOKEN)) @@ -456,7 +469,8 @@ fun parseStyle s pos = | selis of select_item list | select of select | sqlexp of exp - | window of unit option + | window of (exp * exp) option + | pbopt of exp | wopt of exp | groupi of group_item | groupis of group_item list @@ -2036,14 +2050,14 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In let val e = (EVar (["Basis"], "sql_window_count", Infer), loc) in - (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc) + applyWindow loc e window end end) | RANK UNIT window (let val loc = s (RANKleft, windowright) val e = (EVar (["Basis"], "sql_window_rank", Infer), loc) in - (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc) + applyWindow loc e window end) | COUNT LPAREN sqlexp RPAREN window (let val loc = s (COUNTleft, windowright) @@ -2064,7 +2078,7 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In e), loc) val e = (EApp (e, sqlexp), loc) in - (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc) + applyWindow loc e window end end) | sqlagg LPAREN sqlexp RPAREN window (let @@ -2086,7 +2100,7 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In e), loc) val e = (EApp (e, sqlexp), loc) in - (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc) + applyWindow loc e window end end) | COALESCE LPAREN sqlexp COMMA sqlexp RPAREN @@ -2114,7 +2128,16 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In end) window : (NONE) - | OVER LPAREN RPAREN (SOME ()) + | OVER LPAREN pbopt obopt RPAREN (SOME (pbopt, obopt)) + +pbopt : ((EVar (["Basis"], "sql_no_partition", Infer), dummy)) + | PARTITION BY sqlexp (let + val loc = s (PARTITIONleft, sqlexpright) + + val e = (EVar (["Basis"], "sql_partition", Infer), loc) + in + (EApp (e, sqlexp), loc) + end) fname : SYMBOL (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)) | LBRACE eexp RBRACE (eexp) |