Allow subqueries to reference aggregate-only columns of free tables; treat non-COUNT aggregate functions as possibly returning NULL

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)