Ur/Web: tests/dynlines.ur annotate

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>

Mercurial > urweb