From 02e4a322e7a3bcefdfc151c1f65fc5fa4ca4e2e5 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Tue, 21 Dec 2010 17:01:51 -0500 Subject: Allow SQL aggregation over nullable types --- lib/ur/basis.urs | 2 ++ src/monoize.sml | 30 +++++++++++++++++++++++------- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 2a3b9a33..9fa37c5d 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -483,6 +483,7 @@ val sql_count_col : t ::: Type -> sql_aggregate (option t) int class sql_summable val sql_summable_int : sql_summable int val sql_summable_float : sql_summable float +val sql_summable_option : t ::: Type -> sql_summable t -> sql_summable (option t) val sql_avg : t ::: Type -> sql_summable t -> sql_aggregate t t val sql_sum : t ::: Type -> sql_summable t -> sql_aggregate t t @@ -491,6 +492,7 @@ val sql_maxable_int : sql_maxable int val sql_maxable_float : sql_maxable float val sql_maxable_string : sql_maxable string val sql_maxable_time : sql_maxable time +val sql_maxable_option : t ::: Type -> sql_maxable t -> sql_maxable (option t) val sql_max : t ::: Type -> sql_maxable t -> sql_aggregate t t val sql_min : t ::: Type -> sql_maxable t -> sql_aggregate t t diff --git a/src/monoize.sml b/src/monoize.sml index bd5787b4..eccf5714 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2637,24 +2637,32 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val default = case #1 t of L.CFfi ("Basis", s) => - (case s of + SOME (case s of "int" => "0" | "float" => "0.0" | "string" => "''" | "time" => "0" | _ => raise Fail "Illegal type of sql_aggregate [1]") + | L.CApp ((L.CFfi ("Basis", "option"), _), _) => NONE | _ => raise Fail "Illegal type of sql_aggregate [2]" 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 ")"] + + val main = case default of + NONE => main + | SOME default => + strcat [sc "COALESCE(", + main, + sc ("," ^ default ^ ")")] in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), - (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), - strcat [sc "COALESCE(", - (L'.ERel 1, loc), - sc "(", - (L'.ERel 0, loc), - sc (")," ^ default ^ ")")]), loc)), loc), + (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc), fm) end @@ -2664,6 +2672,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.EFfi ("Basis", "sql_summable_int") => ((L'.ERecord [], loc), fm) | L.EFfi ("Basis", "sql_summable_float") => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.EFfi ("Basis", "sql_summable_option"), _), _) => + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), + (L'.ERecord [], loc)), loc), + fm) | L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), (L'.EPrim (Prim.String "AVG"), loc)), loc), @@ -2679,6 +2691,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.EFfi ("Basis", "sql_maxable_int") => ((L'.ERecord [], loc), fm) | L.EFfi ("Basis", "sql_maxable_float") => ((L'.ERecord [], loc), fm) | L.EFfi ("Basis", "sql_maxable_string") => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.EFfi ("Basis", "sql_maxable_option"), _), _) => + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), + (L'.ERecord [], loc)), loc), + fm) | L.ECApp ((L.EFfi ("Basis", "sql_max"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), (L'.EPrim (Prim.String "MAX"), loc)), loc), -- cgit v1.2.3