changeset 782:a44daa674810

Make Effectize more precise
author Adam Chlipala <adamc@hcoop.net>
date Tue, 05 May 2009 10:23:16 -0400
parents c884a42599f3
children ec0a0dd0ca12
files demo/batch.ur demo/batchG.ur demo/increment.ur demo/noisy.ur src/effectize.sml
diffstat 5 files changed, 23 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
--- a/demo/batch.ur	Sun May 03 16:00:43 2009 -0400
+++ b/demo/batch.ur	Tue May 05 10:23:16 2009 -0400
@@ -37,7 +37,7 @@
         </table></xml>}/></xml>
     end
 
-fun action () =
+fun main () =
     lss <- source Nil;
     batched <- source Nil;
 
@@ -79,7 +79,3 @@
           <button value="Execute" onclick={exec ()}/>
         </body></xml>
     end
-
-fun main () = return <xml><body>
-  <form><submit value="Begin demo" action={action}/></form>
-</body></xml>
--- a/demo/batchG.ur	Sun May 03 16:00:43 2009 -0400
+++ b/demo/batchG.ur	Tue May 05 10:23:16 2009 -0400
@@ -1,13 +1,9 @@
 table t : {Id : int, A : string, B : float}
   PRIMARY KEY Id
 
-structure B = BatchFun.Make(struct
-                                val tab = t
-                                val title = "BatchG"
-                                val cols = {A = BatchFun.string "A",
-                                            B = BatchFun.float "B"}
-                            end)
-
-fun main () = return <xml><body>
-  <form><submit value="Begin demo" action={B.main}/></form>
-</body></xml>
+open BatchFun.Make(struct
+                       val tab = t
+                       val title = "BatchG"
+                       val cols = {A = BatchFun.string "A",
+                                   B = BatchFun.float "B"}
+                   end)
--- a/demo/increment.ur	Sun May 03 16:00:43 2009 -0400
+++ b/demo/increment.ur	Tue May 05 10:23:16 2009 -0400
@@ -2,13 +2,9 @@
 
 fun increment () = nextval seq
 
-fun action () =
+fun main () =
     src <- source 0;
     return <xml><body>
       <dyn signal={n <- signal src; return <xml>{[n]}</xml>}/>
       <button value="Update" onclick={n <- increment (); set src n}/>
     </body></xml>
-
-fun main () = return <xml><body>
-  <form><submit value="Begin demo" action={action}/></form>
-</body></xml>
--- a/demo/noisy.ur	Sun May 03 16:00:43 2009 -0400
+++ b/demo/noisy.ur	Tue May 05 10:23:16 2009 -0400
@@ -25,7 +25,7 @@
                  | Some a => a);
         check ls'
 
-fun action () =
+fun main () =
     idAdd <- source "";
     aAdd <- source "";
 
@@ -41,7 +41,3 @@
       <button value="Delete" onclick={id <- get idDel; del (readError id)}/>
       <ctextbox source={idDel}/>
     </body></xml>
-
-fun main () = return <xml><body>
-  <form><submit value="Begin demo" action={action}/></form>
-</body></xml>
--- a/src/effectize.sml	Sun May 03 16:00:43 2009 -0400
+++ b/src/effectize.sml	Tue May 05 10:23:16 2009 -0400
@@ -41,12 +41,25 @@
 
 fun effectize file =
     let
+        fun expOnload evs e =
+            case e of
+                EFfi f => effectful f
+              | EFfiApp (m, x, _) => effectful (m, x)
+              | ENamed n => IM.inDomain (evs, n)
+              | EServerCall (n, _, _, _) => IM.inDomain (evs, n)
+              | _ => false
+
+        fun couldWriteOnload evs = U.Exp.exists {kind = fn _ => false,
+                                                 con = fn _ => false,
+                                                 exp = expOnload evs}
+
         fun exp evs e =
             case e of
                 EFfi f => effectful f
               | EFfiApp (m, x, _) => effectful (m, x)
               | ENamed n => IM.inDomain (evs, n)
-              | EServerCall (n, _, _, _) => IM.inDomain (evs, n)
+              | ERecord xets => List.exists (fn ((CName "Onload", _), e, _) => couldWriteOnload evs e
+                                              | _ => false) xets
               | _ => false
 
         fun couldWrite evs = U.Exp.exists {kind = fn _ => false,