Mercurial > urweb

changeset 697:755a71c99be5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Threads demo
author Adam Chlipala <adamc@hcoop.net>
date Sun, 05 Apr 2009 10:48:11 -0400
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>&lt;body&gt;</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