diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-08-03 16:53:13 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-03 16:53:13 -0400 |
| commit | 289b94cdcffed0874ac10b38d69366d8a43057cf (patch) | |
| tree | c4d4b14d68ae5fbd70a13bbc4e25bd4cd47d03ac | |
| parent | b6123d25d202d3cbe1f12d24dec129a90d5051ec (diff) | |
Push write inside case
| -rw-r--r-- | src/mono_opt.sml | 7 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 2 |
2 files changed, 8 insertions, 1 deletions
diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 414d9677..6fa871ec 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -185,6 +185,13 @@ fun exp e = | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) => EFfiApp ("Basis", "urlifyString_w", [e]) + + | EWrite (ECase (discE, pes, {disc, ...}), loc) => + optExp (ECase (discE, + map (fn (p, e) => (p, (EWrite e, loc))) pes, + {disc = disc, + result = (TRecord [], loc)}), loc) + | _ => e and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e) diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index e780d6d8..07634a57 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -123,7 +123,7 @@ fun exp env e = | EApp ((EAbs (_, _, _, e1), loc), e2) => #1 (reduceExp env (subExpInExp (0, e2) e1)) - | ECase (disc, pes, t) => + | ECase (disc, pes, _) => (case ListUtil.search (fn (p, body) => case match (env, p, disc) of NONE => NONE |