Mercurial > urweb
annotate demo/roundTrip.ur @ 848:e8594cfa3236
Fix MonoReduce unsoundness with lets and fns
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 13 Jun 2009 15:42:24 -0400 |
parents | 15ddd64a5113 |
children | ed06e25c70ef |
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@698 | 24 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> |