diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-09-15 12:23:42 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-15 12:23:42 -0400 |
| commit | 508ac0708d67027aa9d14138d24f4aa427a70c03 (patch) | |
| tree | 6a91bb53b96551cfc883f26a56233821d6768f8c | |
| parent | 605ebe8b290fda0a67b9e1f9b58500a16b696350 (diff) | |
Fixed a Mono_reduce bug, which was breaking selection enabling in Grid
| -rw-r--r-- | demo/more/grid.ur | 6 | ||||
| -rw-r--r-- | demo/more/grid1.ur | 1 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 4 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 41 |
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 |