[MLton-commit] r5433

[Vesa Karvonen]

A toy example that mimics Scala's Actors.
----------------------------------------------------------------------

A   mltonlib/trunk/com/ssh/async/unstable/example/
A   mltonlib/trunk/com/ssh/async/unstable/example/actor/
A   mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml
A   mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.mlb
A   mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.sml
A   mltonlib/trunk/com/ssh/async/unstable/example/actor/counter.sml

----------------------------------------------------------------------

Added: mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml	2007-03-15 14:51:35 UTC (rev 5432)
+++ mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml	2007-03-15 15:01:30 UTC (rev 5433)
@@ -0,0 +1,72 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(*
+ * The goal here is to implement something that is as close to Scala's
+ * Actors as possible while remaining threadless (which means that it is
+ * not possible to get the exact same semantics).  This is neither
+ * optimized nor supposed to demonstrate good SML programming style!  In
+ * particular, Scala's Any type is approximated using SML's {exn} type and
+ * Scala's partial functions are approximated using SML functions that may
+ * raise {Match}.
+ *
+ * Bibliography:
+ * - Philipp Haller and Martin Odersky:
+ *   [http://lampwww.epfl.ch/~odersky/papers/jmlc06.pdf
+ *    Event-Based Programming without Inversion of Control]
+ * - Philipp Haller and Martin Odersky:
+ *   [http://lamp.epfl.ch/~phaller/doc/haller07actorsunify.pdf
+ *    Actors that Unify Threads and Events]
+ *)
+
+structure Actor :> sig
+   type t
+
+   structure Msg : sig
+      type t = Exn.t
+   end
+
+   val new : t Effect.t -> t
+   val start : t Effect.t
+   val += : (t * Msg.t) Effect.t
+   val receive : Msg.t Effect.t -> 'a
+   (* The type says that receive can not return. *)
+end = struct
+   structure Msg = Exn
+
+   datatype t =
+      T of {body : t Effect.t,
+            handler : Msg.t Effect.t Effect.t,
+            send : Msg.t Effect.t}
+
+   exception Receive of Msg.t Effect.t
+
+   open Async
+
+   fun new body = let
+      val msgs = ref [] (* XXX inefficient *)
+      val wakeupCh = SkipCh.new ()
+      fun handler f =
+          recur (!msgs, []) (fn loop =>
+             fn ([], _) => when (SkipCh.take wakeupCh, fn () => handler f)
+              | (m::ms, fms) =>
+                try (fn () => f m,
+                     fn () => msgs := List.revAppend (fms, ms),
+                     fn Match => loop (ms, m::fms)
+                      | Receive f => (msgs := List.revAppend (fms, ms)
+                                    ; handler f)))
+      fun send msg = (msgs := !msgs @ [msg] ; SkipCh.send wakeupCh ())
+   in
+      T {body = body, handler = handler, send = send}
+   end
+
+   fun receive f = raise Receive f
+
+   fun start (this as T {body, handler, ...}) =
+       body this handle Receive f => handler f
+
+   fun (T {send, ...}) += msg = send msg
+end


Property changes on: mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.mlb
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.mlb	2007-03-15 14:51:35 UTC (rev 5432)
+++ mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.mlb	2007-03-15 15:01:30 UTC (rev 5433)
@@ -0,0 +1,22 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+   $(MLTON_LIB)/com/ssh/misc-util/unstable/lib.mlb
+   ../../lib.mlb
+
+   ann
+      "nonexhaustiveExnMatch ignore"
+      "sequenceNonUnit warn"
+      "warnUnused true"
+   in
+      actor.sml
+      counter.sml
+      counter-example.sml
+   end
+in
+end


Property changes on: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.sml	2007-03-15 14:51:35 UTC (rev 5432)
+++ mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.sml	2007-03-15 15:01:30 UTC (rev 5433)
@@ -0,0 +1,23 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+val () = let
+   open Actor
+
+   val actor =
+       new (fn this => let
+                  val counter = Counter.new ()
+               in
+                  start counter
+                ; counter += Counter.Incr
+                ; counter += Counter.Value this
+                ; receive (fn Counter.Int v =>
+                              println (Int.toString v))
+               end)
+in
+   start actor
+ ; Async.Handler.runAll ()
+end


Property changes on: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter-example.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/actor/counter.sml	2007-03-15 14:51:35 UTC (rev 5432)
+++ mltonlib/trunk/com/ssh/async/unstable/example/actor/counter.sml	2007-03-15 15:01:30 UTC (rev 5433)
@@ -0,0 +1,29 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Counter = struct
+   exception Int of Int.t
+
+   exception Incr
+   exception Value of Actor.t
+   exception Lock of Actor.t
+   exception Unlock of Int.t
+
+   fun new () = let
+      open Actor
+   in
+      new (fn _ =>
+         recur 0 (fn loop =>
+            fn value =>
+               (println ("Value: " ^ Int.toString value)
+              ; receive (fn
+                   Incr    => loop (value + 1)
+                 | Value a => (a += Int value ; loop value)
+                 | Lock a  => (a += Int value
+                             ; receive (fn Unlock v => loop v))
+                 | _       => loop value))))
+   end
+end


Property changes on: mltonlib/trunk/com/ssh/async/unstable/example/actor/counter.sml
___________________________________________________________________
Name: svn:eol-style
   + native