diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-06-03 11:29:31 -0400 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-06-03 11:29:31 -0400 |
commit | 6cd9389c53382c936a8bd71c92873906624d2a4e (patch) | |
tree | deacf0a9ebedccbc3e22fdb143c51d3dcc153a5b /src/monoize.sml | |
parent | ecb92d9539880cc59a371c786af5312b833ff8ca (diff) |
Lighter-weight encoding of window function use
Diffstat (limited to 'src/monoize.sml')
-rw-r--r-- | src/monoize.sml | 280 |
1 files changed, 142 insertions, 138 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 8224b26f..4985c932 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -249,7 +249,13 @@ fun monoType env = (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _), _), _) => + | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_expw"), _), _), _), _), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CFfi ("Basis", "sql_window"), _), _) => + (L'.TRecord [], loc) + | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window_function"), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) @@ -299,16 +305,16 @@ 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"), _), _) => (L'.TRecord [], loc) | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_ufunc"), _), _), _), _) => (L'.TFfi ("Basis", "string"), 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", "channel"), _), _) => (L'.TFfi ("Basis", "channel"), loc) @@ -2111,9 +2117,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_inject"), _), - _), _), + (L.EFfi ("Basis", "sql_inject"), _), _), _), _), _), _), _), @@ -2426,7 +2430,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "sql_order_by_Cons"), _), + (L.ECApp ( + (L.EFfi ("Basis", "sql_order_by_Cons"), _), + _), _), _), _), _), _), _) => @@ -2434,19 +2440,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val s = (L'.TFfi ("Basis", "string"), loc) fun sc s = (L'.EPrim (Prim.String s), loc) in - ((L'.EAbs ("e1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), - (L'.EAbs ("d", s, (L'.TFun (s, s), loc), - (L'.EAbs ("e2", s, s, - (L'.ECase ((L'.ERel 0, loc), - [((L'.PPrim (Prim.String ""), loc), - strcat [(L'.ERel 2, loc), - (L'.ERel 1, loc)]), - ((L'.PWild, loc), - strcat [(L'.ERel 2, loc), - (L'.ERel 1, loc), - sc ", ", - (L'.ERel 0, loc)])], - {disc = s, result = s}), loc)), loc)), loc)), loc), + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc), + (L'.EAbs ("e1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), + (L'.EAbs ("d", s, (L'.TFun (s, s), loc), + (L'.EAbs ("e2", s, s, + (L'.ECase ((L'.ERel 0, loc), + [((L'.PPrim (Prim.String ""), loc), + strcat [(L'.ERel 2, loc), + (L'.ERel 1, loc)]), + ((L'.PWild, loc), + strcat [(L'.ERel 2, loc), + (L'.ERel 1, loc), + sc ", ", + (L'.ERel 0, loc)])], + {disc = s, result = s}), loc)), loc)), loc)), loc)), loc), fm) end @@ -2512,10 +2519,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( (L.EFfi ("Basis", "sql_unary"), _), _), _), - _), _), _), _), _), _), _), _), @@ -2544,9 +2549,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_binary"), _), - _), _), + (L.EFfi ("Basis", "sql_binary"), _), _), _), _), _), _), _), @@ -2579,9 +2582,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_field"), _), - _), _), + (L.EFfi ("Basis", "sql_field"), _), _), _), _), _), _), _), @@ -2595,9 +2596,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_exp"), _), - _), _), + (L.EFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), @@ -2701,9 +2700,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_count"), _), - _), _), + (L.EFfi ("Basis", "sql_count"), _), _), _), _), _), _) => ((L'.EPrim (Prim.String "COUNT(*)"), loc), @@ -2714,9 +2711,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_aggregate"), _), - _), _), + (L.EFfi ("Basis", "sql_aggregate"), _), _), _), _), _), _), _), @@ -2732,7 +2727,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = sc ")"] in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), - (L'.EAbs ("e1", s, s, main), loc)), loc), + (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc), fm) end @@ -2781,73 +2776,33 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EPrim (Prim.String "MIN"), loc)), loc)), loc), fm) - | 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.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 ( (L.ECApp ( - (L.EFfi ("Basis", "sql_window"), _), + (L.EFfi ("Basis", "sql_nfunc"), _), _), _), _), _), _), _), - _) => + _) => 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 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, (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), + ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm) end + | L.EFfi ("Basis", "sql_window_normal") => ((L'.ERecord [], loc), fm) + | L.EFfi ("Basis", "sql_window_fancy") => ((L'.ERecord [], loc), fm) | L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "sql_window_aggregate"), _), + (L.EFfi ("Basis", "sql_window"), _), _), _), _), _), _), _), @@ -2855,43 +2810,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) - - val main = strcat [(L'.ERel 1, loc), - sc "(", - (L'.ERel 0, loc), - sc ")"] in - ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), - (L'.EAbs ("e1", s, s, main), loc)), loc), + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, s), loc), + (L'.EAbs ("e", s, s, + (L'.ERel 0, loc)), loc)), loc), fm) end - | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) => - ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm) - | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_rank"), _), _), _), _), _), _) => - ((L'.EPrim (Prim.String "RANK()"), loc), fm) - - | 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 ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_nfunc"), _), - _), _), - _), _), - _), _), - _), _), - _) => - let - val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) - in - ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), - fm) - end | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm) | L.ECApp ( @@ -2899,9 +2824,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_ufunc"), _), - _), _), + (L.EFfi ("Basis", "sql_ufunc"), _), _), _), _), _), _), _), @@ -2935,9 +2858,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_is_null"), _), _), - _), _), + (L.EFfi ("Basis", "sql_is_null"), _), _), _), _), _), _), _), _)) => @@ -2978,11 +2899,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_if_then_else"), _), _), - _), _), - _), _), + (L.EFfi ("Basis", "sql_if_then_else"), _), _), _), _), _), _), _), _)) => @@ -3007,9 +2924,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_nullable"), _), - _), _), + (L.EFfi ("Basis", "sql_nullable"), _), _), _), _), _), _), _), @@ -3030,9 +2945,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_subquery"), _), - _), _), + (L.EFfi ("Basis", "sql_subquery"), _), _), _), _), _), _), _), @@ -3051,6 +2964,97 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end + | 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_function"), _), + _), _), + _), _), + _), _), + _) => + 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 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, (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 + + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_window_aggregate"), _), + _), _), + _), _), + _), _), + _), _), + _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + + val main = strcat [(L'.ERel 1, loc), + sc "(", + (L'.ERel 0, loc), + sc ")"] + in + ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), + (L'.EAbs ("e1", s, s, main), loc)), loc), + fm) + end + + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) => + ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm) + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_rank"), _), _), _), _), _), _) => + ((L'.EPrim (Prim.String "RANK()"), loc), fm) + | L.EFfiApp ("Basis", "nextval", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e |