Avoid unnecessary WHERE clause

4 files changed, 53 insertions, 29 deletions

diff --git a/src/compiler.sig b/src/compiler.sig
index 51ec0537..2549b4f1 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -74,9 +74,12 @@ signature COMPILER = sig
     val toMonoize : (job, Mono.file) transform
     val toMono_opt1 : (job, Mono.file) transform
     val toUntangle : (job, Mono.file) transform
-    val toMono_reduce : (job, Mono.file) transform
-    val toMono_shake : (job, Mono.file) transform
+    val toMono_reduce1 : (job, Mono.file) transform
+    val toMono_shake1 : (job, Mono.file) transform
     val toMono_opt2 : (job, Mono.file) transform
+    val toMono_reduce2 : (job, Mono.file) transform
+    val toMono_opt3 : (job, Mono.file) transform
+    val toMono_shake2 : (job, Mono.file) transform
     val toCjrize : (job, Cjr.file) transform
 
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index 4df71bcd..cc8e459d 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -313,23 +313,29 @@ val mono_reduce = {
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMono_reduce = toUntangle o transform mono_reduce "mono_reduce"
+val toMono_reduce1 = toUntangle o transform mono_reduce "mono_reduce1"
 
 val mono_shake = {
     func = MonoShake.shake,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMono_shake = toMono_reduce o transform mono_shake "mono_shake"
+val toMono_shake1 = toMono_reduce1 o transform mono_shake "mono_shake1"
 
-val toMono_opt2 = toMono_shake o transform mono_opt "mono_opt2"
+val toMono_opt2 = toMono_shake1 o transform mono_opt "mono_opt2"
+
+val toMono_reduce2 = toMono_opt2 o transform mono_reduce "mono_reduce2"
+
+val toMono_opt3 = toMono_reduce2 o transform mono_opt "mono_opt3"
+
+val toMono_shake2 = toMono_opt3 o transform mono_shake "mono_shake2"
 
 val cjrize = {
     func = Cjrize.cjrize,
     print = CjrPrint.p_file CjrEnv.empty
 }
 
-val toCjrize = toMono_opt2 o transform cjrize "cjrize"
+val toCjrize = toMono_shake2 o transform cjrize "cjrize"
 
 fun compileC {cname, oname, ename} =
     let
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 06cc8bbf..caa3c124 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -90,58 +90,61 @@ fun subExpInExp (n, e1) e2 =
 
 fun typ c = c
 
+datatype result = Yes of E.env | No | Maybe
+
 fun match (env, p : pat, e : exp) =
     case (#1 p, #1 e) of
-        (PWild, _) => SOME env
-      | (PVar (x, t), _) => SOME (E.pushERel env x t (SOME e))
+        (PWild, _) => Yes env
+      | (PVar (x, t), _) => Yes (E.pushERel env x t (SOME e))
 
       | (PPrim p, EPrim p') =>
         if Prim.equal (p, p') then
-            SOME env
+            Yes env
         else
-            NONE
+            No
 
       | (PCon (_, PConVar n1, NONE), ECon (_, PConVar n2, NONE)) =>
         if n1 = n2 then
-            SOME env
+            Yes env
         else
-            NONE
+            No
 
       | (PCon (_, PConVar n1, SOME p), ECon (_, PConVar n2, SOME e)) =>
         if n1 = n2 then
             match (env, p, e)
         else
-            NONE
+            No
 
       | (PCon (_, PConFfi {mod = m1, con = con1, ...}, NONE), ECon (_, PConFfi {mod = m2, con = con2, ...}, NONE)) =>
         if m1 = m2 andalso con1 = con2 then
-            SOME env
+            Yes env
         else
-            NONE
+            No
 
       | (PCon (_, PConFfi {mod = m1, con = con1, ...}, SOME ep), ECon (_, PConFfi {mod = m2, con = con2, ...}, SOME e)) =>
         if m1 = m2 andalso con1 = con2 then
             match (env, p, e)
         else
-            NONE
+            No
 
       | (PRecord xps, ERecord xes) =>
         let
             fun consider (xps, env) =
                 case xps of
-                    [] => SOME env
+                    [] => Yes env
                   | (x, p, _) :: rest =>
                     case List.find (fn (x', _, _) => x' = x) xes of
-                        NONE => NONE
+                        NONE => No
                       | SOME (_, e, _) =>
                         case match (env, p, e) of
-                            NONE => NONE
-                          | SOME env => consider (rest, env)
+                            No => No
+                          | Maybe => Maybe
+                          | Yes env => consider (rest, env)
         in
             consider (xps, env)
         end
 
-      | _ => NONE
+      | _ => Maybe
 
 fun exp env e =
     case e of
@@ -163,12 +166,18 @@ fun exp env e =
             #1 (reduceExp env (subExpInExp (0, e2) e1)))
 
       | ECase (disc, pes, _) =>
-        (case ListUtil.search (fn (p, body) =>
-                                  case match (env, p, disc) of
-                                      NONE => NONE
-                                    | SOME env => SOME (#1 (reduceExp env body))) pes of
-             NONE => e
-           | SOME e' => e')
+        let
+            fun search pes =
+                case pes of
+                    [] => e
+                  | (p, body) :: pes =>
+                    case match (env, p, disc) of
+                        No => search pes
+                      | Maybe => e
+                      | Yes env => #1 (reduceExp env body)
+        in
+            search pes
+        end
 
       | EField ((ERecord xes, _), x) =>
         (case List.find (fn (x', _, _) => x' = x) xes of
diff --git a/src/monoize.sml b/src/monoize.sml
index 5341ab99..9846d8ba 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -613,8 +613,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                            sc " FROM ",
                                            strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
                                                                                           sc (" AS " ^ x)]) tables),
-                                           sc " WHERE ",
-                                           gf "Where",
+                                           (L'.ECase (gf "Where",
+                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                        sc ""),
+                                                       ((L'.PWild, loc),
+                                                        strcat loc [sc " WHERE ", gf "Where"])],
+                                                      {disc = s,
+                                                       result = s}), loc),
+                                                        
                                            if List.all (fn (x, xts) =>
                                                            case List.find (fn (x', _) => x' = x) grouped of
                                                                NONE => List.null xts