diff options
author | 2008-08-31 15:32:31 -0400 | |
---|---|---|
committer | 2008-08-31 15:32:31 -0400 | |
commit | dcd7b7d304959739432b3e2497491c36f14f2b4f (patch) | |
tree | bad7181fcc95e17aeb1dbb130a54c7c45d444976 | |
parent | 959f07d717b29f083b275333b38e40e5b9f78a9d (diff) |
Avoid unnecessary WHERE clause
-rw-r--r-- | src/compiler.sig | 7 | ||||
-rw-r--r-- | src/compiler.sml | 14 | ||||
-rw-r--r-- | src/mono_reduce.sml | 51 | ||||
-rw-r--r-- | src/monoize.sml | 10 |
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 |