summaryrefslogtreecommitdiff
path: root/src/mono_reduce.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-15 12:23:42 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-15 12:23:42 -0400
commit56492a2c4801e14de9f195b924bff0b48f68d2c4 (patch)
tree6a91bb53b96551cfc883f26a56233821d6768f8c /src/mono_reduce.sml
parentcbf9a437d79ca88f901d97c4d8881f7d4e711d2d (diff)
Fixed a Mono_reduce bug, which was breaking selection enabling in Grid
Diffstat (limited to 'src/mono_reduce.sml')
-rw-r--r--src/mono_reduce.sml41
1 files changed, 22 insertions, 19 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 171bcef0..3540640c 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -361,8 +361,7 @@ fun reduce file =
unravel (e, 0, [])
end
- | EAbs (_, _, _, e) => List.filter (fn UseRel => true
- | _ => false) (summarize (d + 1) e)
+ | EAbs _ => []
| EUnop (_, e) => summarize d e
| EBinop (_, e1, e2) => summarize d e1 @ summarize d e2
@@ -370,8 +369,8 @@ fun reduce file =
| ERecord xets => List.concat (map (summarize d o #2) xets)
| EField (e, _) => summarize d e
- | ECase (e, pes, _) =>
- let
+ | ECase (e, pes, _) => summarize d e @ [Unsure]
+ (*let
val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes
in
case lss of
@@ -381,7 +380,7 @@ fun reduce file =
summarize d e @ ls
else
[Unsure]
- end
+ end*)
| EStrcat (e1, e2) => summarize d e1 @ summarize d e2
| EError (e, _) => summarize d e @ [Unsure]
@@ -396,9 +395,9 @@ fun reduce file =
| EQuery {query, body, initial, ...} =>
List.concat [summarize d query,
- summarize (d + 2) body,
summarize d initial,
- [ReadDb]]
+ [ReadDb],
+ summarize (d + 2) body]
| EDml e => summarize d e @ [WriteDb]
| ENextval e => summarize d e @ [WriteDb]
@@ -408,9 +407,9 @@ fun reduce file =
| ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
| ESignalSource e => summarize d e
- | EServerCall (e, ek, _, _) => summarize d e @ summarize d ek @ [Unsure]
- | ERecv (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
- | ESleep (e, ek) => summarize d e @ summarize d ek @ [Unsure]
+ | EServerCall (e, _, _, _) => summarize d e @ [Unsure]
+ | ERecv (e, _, _) => summarize d e @ [Unsure]
+ | ESleep (e, _) => summarize d e @ [Unsure]
in
(*Print.prefaces "Summarize"
[("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
@@ -496,7 +495,10 @@ fun reduce file =
#1 r
end
in
- search pes
+ if impure env e' then
+ e
+ else
+ search pes
end
| EField ((ERecord xes, _), x) =>
@@ -532,8 +534,8 @@ fun reduce file =
val r = subExpInExp (0, e') b
in
(*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
- ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
- ("r", MonoPrint.p_exp env r)];*)
+ ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+ ("r", MonoPrint.p_exp env r)];*)
#1 (reduceExp env r)
end
@@ -586,12 +588,13 @@ fun reduce file =
("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
("effs_e'", Print.p_list p_event effs_e'),
("effs_b", Print.p_list p_event effs_b)];*)
- if List.null effs_e'
- orelse (List.all (fn eff => eff <> Unsure) effs_e'
- andalso verifyCompatible effs_b)
- orelse (case effs_b of
- UseRel :: effs => List.all verifyUnused effs
- | _ => false) then
+ if (List.null effs_e'
+ orelse (List.all (fn eff => eff <> Unsure) effs_e'
+ andalso verifyCompatible effs_b)
+ orelse (case effs_b of
+ UseRel :: effs => List.all verifyUnused effs
+ | _ => false))
+ andalso countFree b = 1 then
trySub ()
else
e