diff options
| -rw-r--r-- | demo/buffer.ur | 25 | ||||
| -rw-r--r-- | demo/buffer.urs | 5 | ||||
| -rw-r--r-- | demo/prose | 12 | ||||
| -rw-r--r-- | demo/threads.ur | 17 | ||||
| -rw-r--r-- | demo/threads.urp | 3 | ||||
| -rw-r--r-- | demo/threads.urs | 1 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 2 | ||||
| -rw-r--r-- | src/monoize.sml | 6 |
8 files changed, 68 insertions, 3 deletions
diff --git a/demo/buffer.ur b/demo/buffer.ur new file mode 100644 index 00000000..27e2b805 --- /dev/null +++ b/demo/buffer.ur @@ -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 diff --git a/demo/buffer.urs b/demo/buffer.urs new file mode 100644 index 00000000..58312bbd --- /dev/null +++ b/demo/buffer.urs @@ -0,0 +1,5 @@ +type t + +val create : transaction t +val render : t -> signal xbody +val write : t -> string -> transaction unit @@ -234,3 +234,15 @@ batchG.urp <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> diff --git a/demo/threads.ur b/demo/threads.ur new file mode 100644 index 00000000..ac6d8cee --- /dev/null +++ b/demo/threads.ur @@ -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 diff --git a/demo/threads.urp b/demo/threads.urp new file mode 100644 index 00000000..153e09a9 --- /dev/null +++ b/demo/threads.urp @@ -0,0 +1,3 @@ + +buffer +threads diff --git a/demo/threads.urs b/demo/threads.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/demo/threads.urs @@ -0,0 +1 @@ +val main : unit -> transaction page diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 2f60b26e..dafc6ded 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -61,7 +61,6 @@ fun impure (e, _) = | 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 @@ fun reduce file = | 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 --git a/src/monoize.sml b/src/monoize.sml index d974e373..620e43a5 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -984,6 +984,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 |