summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-05-05 10:23:16 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-05-05 10:23:16 -0400
commit5aff88e5b1dba05e222c601ed628b325ad6fd7f8 (patch)
treebede52199ad6681e3598dd198333b0c9dfef60ff
parentc53eeb25b20757091dfb8f9a085207e867c31baf (diff)
Make Effectize more precise
-rw-r--r--demo/batch.ur6
-rw-r--r--demo/batchG.ur16
-rw-r--r--demo/increment.ur6
-rw-r--r--demo/noisy.ur6
-rw-r--r--src/effectize.sml15
5 files changed, 23 insertions, 26 deletions
diff --git a/demo/batch.ur b/demo/batch.ur
index b7007913..4100749f 100644
--- a/demo/batch.ur
+++ b/demo/batch.ur
@@ -37,7 +37,7 @@ fun show withDel lss =
</table></xml>}/></xml>
end
-fun action () =
+fun main () =
lss <- source Nil;
batched <- source Nil;
@@ -79,7 +79,3 @@ fun action () =
<button value="Execute" onclick={exec ()}/>
</body></xml>
end
-
-fun main () = return <xml><body>
- <form><submit value="Begin demo" action={action}/></form>
-</body></xml>
diff --git a/demo/batchG.ur b/demo/batchG.ur
index ea658164..d0071d7d 100644
--- a/demo/batchG.ur
+++ b/demo/batchG.ur
@@ -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)
diff --git a/demo/increment.ur b/demo/increment.ur
index 36b8191f..a74e80df 100644
--- a/demo/increment.ur
+++ b/demo/increment.ur
@@ -2,13 +2,9 @@ sequence seq
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>
diff --git a/demo/noisy.ur b/demo/noisy.ur
index 7f26eaf2..708cfa2c 100644
--- a/demo/noisy.ur
+++ b/demo/noisy.ur
@@ -25,7 +25,7 @@ fun check ls =
| Some a => a);
check ls'
-fun action () =
+fun main () =
idAdd <- source "";
aAdd <- source "";
@@ -41,7 +41,3 @@ fun action () =
<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>
diff --git a/src/effectize.sml b/src/effectize.sml
index e3d62ff8..c07f74bc 100644
--- a/src/effectize.sml
+++ b/src/effectize.sml
@@ -41,7 +41,7 @@ fun effectful x = Settings.isEffectful x andalso not (Settings.isClientOnly x)
fun effectize file =
let
- fun exp evs e =
+ fun expOnload evs e =
case e of
EFfi f => effectful f
| EFfiApp (m, x, _) => effectful (m, x)
@@ -49,6 +49,19 @@ fun effectize file =
| 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)
+ | ERecord xets => List.exists (fn ((CName "Onload", _), e, _) => couldWriteOnload evs e
+ | _ => false) xets
+ | _ => false
+
fun couldWrite evs = U.Exp.exists {kind = fn _ => false,
con = fn _ => false,
exp = exp evs}