annotate tests/dynlines.ur @ 2063:83bdb52962c9

Check realloc's return code to prevent segfault on out of memoty condition
author Sergey Mironov <grrwlf@gmail.com>
date Sat, 23 Aug 2014 11:59:34 +0000
parents 38297294cf98
children
rev   line source
adam@1800 1 datatype lines = End | Line of source lines
adam@1800 2
adam@1800 3 type t = { Head : source lines, Tail : source (source lines) }
adam@1800 4
adam@1800 5 val create =
adam@1800 6 head <- source End;
adam@1800 7 tail <- source head;
adam@1800 8 return {Head = head, Tail = tail}
adam@1800 9
adam@1800 10 fun renderL lines =
adam@1800 11 case lines of
adam@1800 12 End => <xml/>
adam@1800 13 | Line linesS => <xml>X<br/><dyn signal={renderS linesS}/></xml>
adam@1800 14
adam@1800 15 and renderS linesS =
adam@1800 16 lines <- signal linesS;
adam@1800 17 return (renderL lines)
adam@1800 18
adam@1800 19 fun render t = renderS t.Head
adam@1800 20
adam@1800 21 fun write t =
adam@1800 22 oldTail <- get t.Tail;
adam@1800 23 newTail <- source End;
adam@1800 24 set oldTail (Line newTail);
adam@1800 25 set t.Tail newTail
adam@1800 26
adam@1800 27 fun main () : transaction page =
adam@1800 28 b <- create;
adam@1800 29
adam@1800 30 return <xml><body>
adam@1800 31 <button onclick={fn _ => write b}/>
adam@1800 32 <dyn signal={render b}/>
adam@1800 33 </body></xml>