changeset 941:b8d7a47b8e0c

Fixed a Mono_reduce bug, which was breaking selection enabling in Grid
author Adam Chlipala <adamc@hcoop.net>
date Tue, 15 Sep 2009 12:23:42 -0400
parents e2be476673f2
children 280f81731426
files demo/more/grid.ur demo/more/grid1.ur lib/ur/basis.urs src/mono_reduce.sml
diffstat 4 files changed, 28 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/grid.ur	Tue Sep 15 11:18:20 2009 -0400
+++ b/demo/more/grid.ur	Tue Sep 15 12:23:42 2009 -0400
@@ -143,10 +143,10 @@
                               <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 @@
                                   (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>)
--- a/demo/more/grid1.ur	Tue Sep 15 11:18:20 2009 -0400
+++ b/demo/more/grid1.ur	Tue Sep 15 12:23:42 2009 -0400
@@ -69,6 +69,7 @@
       <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>
--- a/lib/ur/basis.urs	Tue Sep 15 11:18:20 2009 -0400
+++ b/lib/ur/basis.urs	Tue Sep 15 12:23:42 2009 -0400
@@ -680,10 +680,10 @@
   -> 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) [] []
 
 
--- a/src/mono_reduce.sml	Tue Sep 15 11:18:20 2009 -0400
+++ b/src/mono_reduce.sml	Tue Sep 15 12:23:42 2009 -0400
@@ -361,8 +361,7 @@
                             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 @@
                       | 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 @@
                                     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 @@
 
                       | 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 @@
                       | 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 @@
                                             #1 r
                                         end
                         in
-                            search pes
+                            if impure env e' then
+                                e
+                            else
+                                search pes
                         end
 
                       | EField ((ERecord xes, _), x) =>
@@ -532,8 +534,8 @@
                                     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 @@
                                                     ("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