Ur/Web: tests/channelThief.ur annotate

Reduce: add reduction in some spots previously missed, associated with 'case' return types

author	Adam Chlipala <adam@chlipala.net>
date	Wed, 25 Nov 2015 18:48:17 -0500
parents	a671e5258a2c
children

rev	line source
adam@1942	1 table t : { Ch : channel string }
adam@1942	2
adam@1942	3 fun go () =
adam@1942	4 let
adam@1942	5 fun overwrite () =
adam@1942	6 dml (DELETE FROM t WHERE TRUE);
adam@1942	7 ch <- channel;
adam@1942	8 dml (INSERT INTO t (Ch) VALUES ({[ch]}));
adam@1942	9 return ch
adam@1942	10
adam@1942	11 fun retrieve () =
adam@1942	12 oneRowE1 (SELECT (t.Ch) FROM t)
adam@1942	13
adam@1942	14 fun transmit () =
adam@1942	15 ch <- retrieve ();
adam@1942	16 send ch "Test"
adam@1942	17
adam@1942	18 fun listenOn ch =
adam@1942	19 s <- recv ch;
adam@1942	20 alert s
adam@1942	21 in
adam@1942	22 ch <- overwrite ();
adam@1942	23 return <xml><body onload={listenOn ch}>
adam@1942	24 <button value="overwrite" onclick={fn _ => ch <- rpc (overwrite ()); listenOn ch}/>
adam@1942	25 <button value="retrieve" onclick={fn _ => ch <- rpc (retrieve ()); listenOn ch}/>
adam@1942	26 <button value="transmit" onclick={fn _ => rpc (transmit ())}/>
adam@1942	27 </body></xml>
adam@1942	28 end
adam@1942	29
adam@1942	30 fun main () = return <xml><body>
adam@1942	31 <form><submit action={go}/></form>
adam@1942	32 </body></xml>

Mercurial > urweb