Mercurial > urweb
annotate demo/roundTrip.ur @ 1355:ccf1d445b794
Hopeful fix to stop Especialize infinite looping
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Tue, 21 Dec 2010 13:57:12 -0500 |
parents | ed06e25c70ef |
children |
rev | line source |
---|---|
adamc@698 | 1 table channels : { Client : client, Channel : channel (string * int * float) } |
adamc@708 | 2 PRIMARY KEY Client |
adamc@698 | 3 |
adamc@698 | 4 fun writeBack v = |
adamc@698 | 5 me <- self; |
adamc@698 | 6 r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]}); |
adamc@698 | 7 send r.Channels.Channel v |
adamc@698 | 8 |
adamc@733 | 9 fun action () = |
adamc@698 | 10 me <- self; |
adamc@698 | 11 ch <- channel; |
adamc@698 | 12 dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]})); |
adamc@698 | 13 |
adamc@698 | 14 buf <- Buffer.create; |
adamc@698 | 15 |
adamc@698 | 16 let |
adamc@698 | 17 fun receiver () = |
adamc@698 | 18 v <- recv ch; |
adamc@698 | 19 Buffer.write buf ("(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")"); |
adamc@698 | 20 receiver () |
adamc@698 | 21 |
adamc@698 | 22 fun sender s n f = |
adamc@698 | 23 sleep 2000; |
adamc@908 | 24 rpc (writeBack (s, n, f)); |
adamc@698 | 25 sender (s ^ "!") (n + 1) (f + 1.23) |
adamc@698 | 26 in |
adamc@698 | 27 return <xml><body onload={spawn (receiver ()); sender "" 0 0.0}> |
adamc@698 | 28 <dyn signal={Buffer.render buf}/> |
adamc@698 | 29 </body></xml> |
adamc@698 | 30 end |
adamc@733 | 31 |
adamc@733 | 32 fun main () = return <xml><body> |
adamc@733 | 33 <form><submit value="Begin demo" action={action}/></form> |
adamc@733 | 34 </body></xml> |