Mercurial > urweb
changeset 697:755a71c99be5
Threads demo
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 05 Apr 2009 10:48:11 -0400 (2009-04-05) |
parents | 79a49c509007 |
children | 9b29ce0babb8 |
files | demo/buffer.ur demo/buffer.urs demo/prose demo/threads.ur demo/threads.urp demo/threads.urs src/mono_reduce.sml src/monoize.sml |
diffstat | 8 files changed, 68 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/buffer.ur Sun Apr 05 10:48:11 2009 -0400 @@ -0,0 +1,25 @@ +datatype lines = End | Line of string * source lines + +type t = { Head : source lines, Tail : source (source lines) } + +val create = + head <- source End; + tail <- source head; + return {Head = head, Tail = tail} + +fun renderL lines = + case lines of + End => <xml/> + | Line (line, linesS) => <xml>{[line]}<br/><dyn signal={renderS linesS}/></xml> + +and renderS linesS = + lines <- signal linesS; + return (renderL lines) + +fun render t = renderS t.Head + +fun write t s = + oldTail <- get t.Tail; + newTail <- source End; + set oldTail (Line (s, newTail)); + set t.Tail newTail
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/buffer.urs Sun Apr 05 10:48:11 2009 -0400 @@ -0,0 +1,5 @@ +type t + +val create : transaction t +val render : t -> signal xbody +val write : t -> string -> transaction unit
--- a/demo/prose Sun Apr 05 09:26:00 2009 -0400 +++ b/demo/prose Sun Apr 05 10:48:11 2009 -0400 @@ -234,3 +234,15 @@ <p><tt>BatchFun.Make</tt> handles the plumbing of allocating the local state, using it to create widgets, and reading the state values when the user clicks "Batch it."</p> <p><tt>batchG.ur</tt> contains an example instantiation, which is just as easy to write as in the <tt>Crud1</tt> example.</p> + +threads.urp + +<p>Ur/Web makes it easy to write multi-threaded client-side code. This example demonstrates two threads writing to a page at once.</p> + +<p>First, we define a useful component for sections of pages that can have lines of text added to them dynamically. This is the <tt>Buffer</tt> module. It contains an abstract type of writable regions, along with functions to create a region, retrieve a signal representing its HTML rendering, and add a new line to it.</p> + +<p>The entry point to the main module <tt>Threads</tt> begins by creating a buffer. The function <tt>loop</tt> implements writing to that buffer periodically, incrementing a counter each time. The arguments to <tt>loop</tt> specify a prefix for the messages and the number of milliseconds to wait between writes.</p> + +<p>We specify some client-side code to run on page load using the <tt>onload</tt> attribute of <tt><body></tt>. The <tt>onload</tt> code in this example spawns two separate threads running the <tt>loop</tt> code with different prefixes, update intervals, and starting counters.</p> + +<p>Old hands at concurrent programming may be worried at the lack of synchronization in this program. Ur/Web uses <i>cooperative multi-threading</i>, not the more common <i>preemptive</i> multi-threading. Only one thread runs at a time, and only particular function calls can trigger context switches. In this example, <tt>sleep</tt> is the only such function that appears.</p>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/threads.ur Sun Apr 05 10:48:11 2009 -0400 @@ -0,0 +1,17 @@ +fun main () = + buf <- Buffer.create; + let + fun loop prefix delay = + let + fun loop' n = + Buffer.write buf (prefix ^ ": Message #" ^ show n); + sleep delay; + loop' (n + 1) + in + loop' + end + in + return <xml><body onload={spawn (loop "A" 5000 0); spawn (loop "B" 3000 100)}> + <dyn signal={Buffer.render buf}/> + </body></xml> + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/threads.urp Sun Apr 05 10:48:11 2009 -0400 @@ -0,0 +1,3 @@ + +buffer +threads
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/threads.urs Sun Apr 05 10:48:11 2009 -0400 @@ -0,0 +1,1 @@ +val main : unit -> transaction page
--- a/src/mono_reduce.sml Sun Apr 05 09:26:00 2009 -0400 +++ b/src/mono_reduce.sml Sun Apr 05 10:48:11 2009 -0400 @@ -61,7 +61,6 @@ | EFfiApp ("Basis", "new_channel", _) => true | EFfiApp ("Basis", "subscribe", _) => true | EFfiApp ("Basis", "send", _) => true - | EFfiApp ("Basis", "recv", _) => true | EFfiApp _ => false | EApp ((EFfi _, _), _) => false | EApp _ => true @@ -283,7 +282,6 @@ | EFfiApp ("Basis", "new_channel", es) => ffi es | EFfiApp ("Basis", "subscribe", es) => ffi es | EFfiApp ("Basis", "send", es) => ffi es - | EFfiApp ("Basis", "recv", es) => ffi es | EFfiApp (_, _, es) => List.concat (map (summarize d) es) | EApp ((EFfi _, _), e) => summarize d e | EApp _ =>
--- a/src/monoize.sml Sun Apr 05 09:26:00 2009 -0400 +++ b/src/monoize.sml Sun Apr 05 10:48:11 2009 -0400 @@ -984,6 +984,7 @@ loc)), loc)), loc)), loc)), loc), fm) end + | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), (L.EFfi ("Basis", "transaction_monad"), _)), _), (L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), @@ -1002,6 +1003,8 @@ t1), loc)), loc)), loc), fm) end + | L.EFfiApp ("Basis", "recv", _) => poly () + | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), (L.EFfi ("Basis", "transaction_monad"), _)), _), (L.EAbs (_, _, _, @@ -1014,11 +1017,12 @@ in ((L'.EAbs ("m2", (L'.TFun (un, mt2), loc), (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, - (L'.ESleep (n, (L'.EApp ((L'.ERel 1, loc), + (L'.ESleep (liftExpInExp 0 n, (L'.EApp ((L'.ERel 1, loc), (L'.ERecord [], loc)), loc)), loc)), loc)), loc), fm) end + | L.EFfiApp ("Basis", "sleep", _) => poly () | L.ECApp ((L.EFfi ("Basis", "source"), _), t) => let