summaryrefslogtreecommitdiff
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
commit508ac0708d67027aa9d14138d24f4aa427a70c03 (patch)
tree6a91bb53b96551cfc883f26a56233821d6768f8c
parent605ebe8b290fda0a67b9e1f9b58500a16b696350 (diff)
Fixed a Mono_reduce bug, which was breaking selection enabling in Grid
-rw-r--r--demo/more/grid.ur6
-rw-r--r--demo/more/grid1.ur1
-rw-r--r--lib/ur/basis.urs4
-rw-r--r--src/mono_reduce.sml41
4 files changed, 28 insertions, 24 deletions
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 56230c8e..412fe585 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -143,10 +143,10 @@ functor Make(M : sig
<xml><tr class={tr}>
<td>
<dyn signal={b <- signal grid.Selection;
- return (if not b then
+ return (if b then
<xml><ccheckbox source={sd}/></xml>
else
- <xml>No</xml>)}/>
+ <xml/>)}/>
</td>
<td>
@@ -200,7 +200,7 @@ functor Make(M : sig
(fn [t] meta => meta.Initial)
[_] M.aggFolder M.aggregates) grid.Rows;
return <xml><tr>
- <td/><td/>
+ <th colspan={3}>Aggregates</th>
{foldRX2 [aggregateMeta M.row] [id] [_]
(fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc =>
<xml><td class={agg}>{meta.Display acc}</td></xml>)
diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur
index bad193bb..c163c9d5 100644
--- a/demo/more/grid1.ur
+++ b/demo/more/grid1.ur
@@ -69,6 +69,7 @@ fun main () =
<body onload={sync grid}>
{render grid}
<hr/>
+ <ccheckbox source={showSelection grid}/> Show selection<br/>
Selection: <dyn signal={ls <- selection grid;
return (List.mapX (fn r => <xml>{[r.Id]}; </xml>) ls)}/>
</body>
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 9f5a9b97..04404ad5 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -680,10 +680,10 @@ val tr : other ::: {Unit} -> [other ~ [Body, Table, Tr]] => unit
-> tag tableEvents
([Body, Table] ++ other) ([Body, Tr] ++ other) [] []
val th : other ::: {Unit} -> [other ~ [Body, Tr]] => unit
- -> tag tableEvents
+ -> tag ([Colspan = int] ++ tableEvents)
([Body, Tr] ++ other) ([Body] ++ other) [] []
val td : other ::: {Unit} -> [other ~ [Body, Tr]] => unit
- -> tag tableEvents
+ -> tag ([Colspan = int] ++ tableEvents)
([Body, Tr] ++ other) ([Body] ++ other) [] []
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