diff options
author | 2011-01-15 14:53:13 -0500 | |
---|---|---|
committer | 2011-01-15 14:53:13 -0500 | |
commit | 5ec949e910342f6212c85c8df75283d091817408 (patch) | |
tree | f006a9c9104c45938d59a3ee34e251ada814e5e1 /src | |
parent | e3ce087d0a3473e3905556c226d6c5bbb2bc9a39 (diff) |
Allow subqueries to reference aggregate-only columns of free tables; treat non-COUNT aggregate functions as possibly returning NULL
Diffstat (limited to 'src')
-rw-r--r-- | src/compiler.sml | 10 | ||||
-rw-r--r-- | src/mono_env.sig | 3 | ||||
-rw-r--r-- | src/mono_env.sml | 13 | ||||
-rw-r--r-- | src/mono_reduce.sml | 39 | ||||
-rw-r--r-- | src/monoize.sml | 63 |
5 files changed, 74 insertions, 54 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index c8bb036a..61fa23b1 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -1311,9 +1311,15 @@ fun compileC {cname, oname, ename, libs, profile, debug, link = link'} = (compile, link) val link = foldl (fn (s, link) => link ^ " " ^ s) link link' + + fun system s = + (if debug then + print (s ^ "\n") + else + (); + OS.Process.isSuccess (OS.Process.system s)) in - OS.Process.isSuccess (OS.Process.system compile) - andalso OS.Process.isSuccess (OS.Process.system link) + system compile andalso system link end fun compile job = diff --git a/src/mono_env.sig b/src/mono_env.sig index c5ca7c0b..97d7d9ea 100644 --- a/src/mono_env.sig +++ b/src/mono_env.sig @@ -50,5 +50,6 @@ signature MONO_ENV = sig val patBindsN : Mono.pat -> int val liftExpInExp : int -> Mono.exp -> Mono.exp - + val subExpInExp : (int * Mono.exp) -> Mono.exp -> Mono.exp + end diff --git a/src/mono_env.sml b/src/mono_env.sml index 1df38db3..7f9a6e62 100644 --- a/src/mono_env.sml +++ b/src/mono_env.sml @@ -85,6 +85,19 @@ val liftExpInExp = bind = fn (bound, U.Exp.RelE _) => bound + 1 | (bound, _) => bound} +val subExpInExp = + U.Exp.mapB {typ = fn t => t, + exp = fn (xn, rep) => fn e => + case e of + ERel xn' => + (case Int.compare (xn', xn) of + EQUAL => #1 rep + | GREATER=> ERel (xn' - 1) + | LESS => e) + | _ => e, + bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep) + | (ctx, _) => ctx} + fun pushERel (env : env) x t eo = {datatypes = #datatypes env, constructors = #constructors env, diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index e61ed237..82d0a63d 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -57,7 +57,6 @@ fun simpleImpure (tsyms, syms) = | ERecv _ => true | ESleep _ => true | ENamed n => IS.member (syms, n) - | EError _ => true | ERel n => let val (_, t, _) = E.lookupERel env n @@ -398,7 +397,10 @@ fun reduce file = summarize d e @ [ReadCookie] | EFfiApp (m, x, es) => if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then - List.concat (map (summarize d) es) @ [Unsure] + List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then + WritePage + else + Unsure] else List.concat (map (summarize d) es) | EApp ((EFfi _, _), e) => summarize d e @@ -429,6 +431,7 @@ fun reduce file = | EApp (f, x) => unravel (#1 f, passed + 1, List.revAppend (summarize d x, ls)) + | EError _ => [Abort] | _ => [Unsure] in unravel (e, 0, []) @@ -445,17 +448,25 @@ fun reduce file = | ECase (e, pes, _) => let val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes + + fun splitRel ls acc = + case ls of + [] => (acc, false, ls) + | UseRel :: ls => (acc, true, ls) + | v :: ls => splitRel ls (v :: acc) + + val (pre, used, post) = foldl (fn (ls, (pre, used, post)) => + let + val (pre', used', post') = splitRel ls [] + in + (pre' @ pre, used' orelse used, post' @ post) + end) + ([], false, []) lss in - case lss of - [] => summarize d e - | ls :: lss => - summarize d e - @ (if List.all (fn ls' => ls' = ls) lss then - ls - else if length (List.filter (not o List.null) (ls :: lss)) <= 1 then - valOf (List.find (not o List.null) (ls :: lss)) - else - [Unsure]) + summarize d e + @ pre + @ (if used then [UseRel] else []) + @ post end | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 @@ -534,8 +545,8 @@ fun reduce file = val effs_e' = List.filter (fn x => x <> UseRel) effs_e' val effs_b = summarize 0 b - (*val () = Print.prefaces "Try" - [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), + (*val () = Print.fprefaces outf "Try" + [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*) ("e'", MonoPrint.p_exp env e'), ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), ("e'_eff", p_events effs_e'), diff --git a/src/monoize.sml b/src/monoize.sml index 30dfdd46..4295811a 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -236,9 +236,9 @@ fun monoType env = (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "sql_sequence") => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _), _), _) => + | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _), _), _) => + | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) @@ -1908,7 +1908,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = end | _ => poly ()) - | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _) => + | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _), _), _) => let fun sc s = (L'.EPrim (Prim.String s), loc) val s = (L'.TFfi ("Basis", "string"), loc) @@ -1934,7 +1934,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "sql_query1"), _), + (L.ECApp ( + (L.EFfi ("Basis", "sql_query1"), _), + _), _), _), _), (L.CRecord (_, tables), _)), _), (L.CRecord (_, grouped), _)), _), @@ -2592,7 +2594,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "sql_forget_tables"), _), + (L.ECApp ( + (L.EFfi ("Basis", "sql_forget_tables"), _), + _), _), _), _), _), _), _), _), @@ -2625,7 +2629,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.EFfi ("Basis", "sql_count"), _), _), _), _), _), - _) => ((L'.EPrim (Prim.String "COALESCE(COUNT(*),0)"), loc), + _) => ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm) | L.ECApp ( @@ -2640,18 +2644,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _), _), t) => let - val default = - case #1 t of - L.CFfi ("Basis", s) => - 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) @@ -2659,13 +2651,6 @@ fun monoExp (env, st, fm) (all as (e, 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), main), loc)), loc), @@ -2682,13 +2667,15 @@ 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.EFfi ("Basis", "sql_avg"), _), _) => - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "AVG"), loc)), loc), + | 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), fm) - | L.ECApp ((L.EFfi ("Basis", "sql_sum"), _), _) => - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "SUM"), loc)), loc), + | 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), + (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), + (L'.EPrim (Prim.String "SUM"), loc)), loc)), loc), fm) | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm) @@ -2701,13 +2688,15 @@ 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.EFfi ("Basis", "sql_max"), _), _) => - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "MAX"), loc)), loc), + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_max"), _), _), _), _) => + ((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 "MAX"), loc)), loc)), loc), fm) - | L.ECApp ((L.EFfi ("Basis", "sql_min"), _), _) => - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "MIN"), loc)), loc), + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_min"), _), _), _), _) => + ((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 "MIN"), loc)), loc)), loc), fm) | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm) |