# HG changeset patch # User Adam Chlipala # Date 1238942891 14400 # Node ID 755a71c99be591b569dd38838cd704c4aa241a58 # Parent 79a49c509007e871af5f22d031a2e5817fd707a8 Threads demo diff -r 79a49c509007 -r 755a71c99be5 demo/buffer.ur --- /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 => + | Line (line, linesS) => {[line]}
+ +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 diff -r 79a49c509007 -r 755a71c99be5 demo/buffer.urs --- /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 diff -r 79a49c509007 -r 755a71c99be5 demo/prose --- 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 @@

BatchFun.Make handles the plumbing of allocating the local state, using it to create widgets, and reading the state values when the user clicks "Batch it."

batchG.ur contains an example instantiation, which is just as easy to write as in the Crud1 example.

+ +threads.urp + +

Ur/Web makes it easy to write multi-threaded client-side code. This example demonstrates two threads writing to a page at once.

+ +

First, we define a useful component for sections of pages that can have lines of text added to them dynamically. This is the Buffer 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.

+ +

The entry point to the main module Threads begins by creating a buffer. The function loop implements writing to that buffer periodically, incrementing a counter each time. The arguments to loop specify a prefix for the messages and the number of milliseconds to wait between writes.

+ +

We specify some client-side code to run on page load using the onload attribute of <body>. The onload code in this example spawns two separate threads running the loop code with different prefixes, update intervals, and starting counters.

+ +

Old hands at concurrent programming may be worried at the lack of synchronization in this program. Ur/Web uses cooperative multi-threading, not the more common preemptive multi-threading. Only one thread runs at a time, and only particular function calls can trigger context switches. In this example, sleep is the only such function that appears.

diff -r 79a49c509007 -r 755a71c99be5 demo/threads.ur --- /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 + + + end diff -r 79a49c509007 -r 755a71c99be5 demo/threads.urp --- /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 diff -r 79a49c509007 -r 755a71c99be5 demo/threads.urs --- /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 diff -r 79a49c509007 -r 755a71c99be5 src/mono_reduce.sml --- 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 _ => diff -r 79a49c509007 -r 755a71c99be5 src/monoize.sml --- 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