Mercurial > urweb
diff src/monoize.sml @ 1778:818d4097e2ed
Lighter-weight encoding of window function use
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 03 Jun 2012 11:29:31 -0400 |
| parents | 59b07fdae1ff |
| children | 5bc4fbf9c0fe |
line wrap: on
line diff
--- a/src/monoize.sml Sat Jun 02 16:47:09 2012 -0400 +++ b/src/monoize.sml Sun Jun 03 11:29:31 2012 -0400 @@ -249,7 +249,13 @@ (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 @@ (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 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_inject"), _), - _), _), + (L.EFfi ("Basis", "sql_inject"), _), _), _), _), _), _), _), @@ -2426,7 +2430,9 @@ | 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 @@ 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 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( (L.EFfi ("Basis", "sql_unary"), _), _), _), - _), _), _), _), _), _), _), _), @@ -2544,9 +2549,7 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_binary"), _), - _), _), + (L.EFfi ("Basis", "sql_binary"), _), _), _), _), _), _), _), @@ -2579,9 +2582,7 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_field"), _), - _), _), + (L.EFfi ("Basis", "sql_field"), _), _), _), _), _), _), _), @@ -2595,9 +2596,7 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_exp"), _), - _), _), + (L.EFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), @@ -2701,9 +2700,7 @@ | 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 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_aggregate"), _), - _), _), + (L.EFfi ("Basis", "sql_aggregate"), _), _), _), _), _), _), _), @@ -2732,7 +2727,7 @@ 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,18 +2776,34 @@ (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.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_partition"), _), + (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_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"), _), + _), _), _), _), _), _), _), _), @@ -2800,108 +2811,20 @@ 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), + ((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.ECApp ( - (L.EFfi ("Basis", "sql_window"), _), - _), _), - _), _), - _), _), - _) => - 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.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm) | 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_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 ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_ufunc"), _), - _), _), + (L.EFfi ("Basis", "sql_ufunc"), _), _), _), _), _), _), _), @@ -2935,9 +2858,7 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_is_null"), _), _), - _), _), + (L.EFfi ("Basis", "sql_is_null"), _), _), _), _), _), _), _), _)) => @@ -2978,11 +2899,7 @@ (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 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_nullable"), _), - _), _), + (L.EFfi ("Basis", "sql_nullable"), _), _), _), _), _), _), _), @@ -3030,9 +2945,7 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "sql_subquery"), _), - _), _), + (L.EFfi ("Basis", "sql_subquery"), _), _), _), _), _), _), _), @@ -3051,6 +2964,97 @@ 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