Mercurial > urweb
changeset 258:40c33706d887
Avoid unnecessary WHERE clause
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 31 Aug 2008 15:32:31 -0400 |
| parents | 32f9212583b2 |
| children | d1b679dbbc25 |
| files | src/compiler.sig src/compiler.sml src/mono_reduce.sml src/monoize.sml |
| diffstat | 4 files changed, 53 insertions(+), 29 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sig Sun Aug 31 15:18:00 2008 -0400 +++ b/src/compiler.sig Sun Aug 31 15:32:31 2008 -0400 @@ -74,9 +74,12 @@ 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
--- a/src/compiler.sml Sun Aug 31 15:18:00 2008 -0400 +++ b/src/compiler.sml Sun Aug 31 15:32:31 2008 -0400 @@ -313,23 +313,29 @@ 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
--- a/src/mono_reduce.sml Sun Aug 31 15:18:00 2008 -0400 +++ b/src/mono_reduce.sml Sun Aug 31 15:32:31 2008 -0400 @@ -90,58 +90,61 @@ 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 @@ #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
--- a/src/monoize.sml Sun Aug 31 15:18:00 2008 -0400 +++ b/src/monoize.sml Sun Aug 31 15:32:31 2008 -0400 @@ -613,8 +613,14 @@ 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