From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Wed, 25 Jan 2017 17:42:20 +0000 (-0600)
Subject: actors: Switch over to using wrap-rmeta-slot for build-actions.
X-Git-Tag: v0.4.2~8
X-Git-Url: https://jxself.org/git/?p=8sync.git;a=commitdiff_plain;h=8bdfa5c8f81d4e46d57c367da23cd8ea676ad717

actors: Switch over to using wrap-rmeta-slot for build-actions.

* 8sync/rmeta-slot.scm (wrap-rmeta-slot): New variable.

* 8sync/actors.scm (build-actions): Switch from using make-rmeta-slot
to using wrap-rmeta-slot.

* doc/8sync.texi (Writing our own actors): Update documentation
to use #:init-thunk.

* 8sync/actors.scm (<actor>, define-actor, <hive>):
* 8sync/systems/irc.scm (<irc-bot>):
* demos/actors/robotscanner.scm (<warehouse-room>, <droid>):
* tests/test-actors.scm (<hi-on-init>):
* tests/test-rmeta-slot.scm (<kah-lassy>, <sub-lassy>): Update to
use #:init-thunk instead of #:init-value on actions slot.
---

diff --git a/8sync/actors.scm b/8sync/actors.scm
index 204582d..d6dc148 100644
--- a/8sync/actors.scm
+++ b/8sync/actors.scm
@@ -311,7 +311,7 @@ raise an exception if an error."
   "Construct an alist of (symbol . method), where the method is wrapped
 with wrap-apply to facilitate live hacking and allow the method definition
 to come after class definition."
-  (make-rmeta-slot
+  (wrap-rmeta-slot
    (list (cons (quote symbol)
                (wrap-apply method)) ...)))
 
@@ -339,7 +339,7 @@ to come after class definition."
                #:allocation #:each-subclass)
 
   ;; This is the default, "simple" way to inherit and process messages.
-  (actions #:init-value (build-actions
+  (actions #:init-thunk (build-actions
                          ;; Default init method is to do nothing.
                          (*init* (const #f))
                          ;; Default cleanup method is to do nothing.
@@ -390,7 +390,7 @@ to come after class definition."
                       (action ...)
                       slots ...)
   (define-class class inherits
-    (actions #:init-value (build-actions action ...)
+    (actions #:init-thunk (build-actions action ...)
              #:allocation #:each-subclass)
     slots ...))
 
@@ -424,7 +424,7 @@ to come after class definition."
   (prompt #:init-thunk make-prompt-tag
           #:getter hive-prompt)
   (actions #:allocation #:each-subclass
-           #:init-value
+           #:init-thunk
            (build-actions
             ;; This is in the case of an ambassador failing to forward a
             ;; message... it reports it back to the hive
diff --git a/8sync/rmeta-slot.scm b/8sync/rmeta-slot.scm
index 7a3fe32..6c4ef6d 100644
--- a/8sync/rmeta-slot.scm
+++ b/8sync/rmeta-slot.scm
@@ -21,7 +21,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (ice-9 match)
 
-  #:export (make-rmeta-slot
+  #:export (wrap-rmeta-slot
+            rmeta-slot-table rmeta-slot-cache
             maybe-build-rmeta-slot-cache!
             class-rmeta-ref))
 
@@ -40,8 +41,8 @@
 ;;;   ;; Define a class with a meta-slot
 ;;;   (define-class <kah-lassy> ()
 ;;;     (entries #:allocation #:each-subclass
-;;;              #:init-value
-;;;              (make-rmeta-slot
+;;;              #:init-thunk
+;;;              (wrap-rmeta-slot
 ;;;               `((foo . "bar")
 ;;;                 (baz . "basil")))))
 ;;;
@@ -52,8 +53,8 @@
 ;;;   ;; Define a subclass
 ;;;   (define-class <sub-lassy> (<kah-lassy>)
 ;;;     (entries #:allocation #:each-subclass
-;;;              #:init-value
-;;;              (make-rmeta-slot
+;;;              #:init-thunk
+;;;              (wrap-rmeta-slot
 ;;;               `((foo . "foo2")
 ;;;                 (peanut . "gallery")))))
 ;;;
@@ -71,6 +72,11 @@
 (define (make-rmeta-slot table)
   (%make-rmeta-slot table #f))
 
+(define (wrap-rmeta-slot table)
+  "In general, using wrap-rmeta-slot in combination with "
+  (lambda ()
+    (make-rmeta-slot table)))
+
 ;; Immutable and unique
 (define %the-nothing (cons '*the* '*nothing*))
 
diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm
index 5d2b66b..fff3461 100755
--- a/8sync/systems/irc.scm
+++ b/8sync/systems/irc.scm
@@ -159,7 +159,7 @@
         #:getter irc-bot-port)
   (socket #:accessor irc-bot-socket)
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (*init* irc-bot-init)
                          (*cleanup* irc-bot-cleanup)
                          (main-loop irc-bot-main-loop)
diff --git a/demos/actors/robotscanner.scm b/demos/actors/robotscanner.scm
index 7ed6dd2..feb8f14 100644
--- a/demos/actors/robotscanner.scm
+++ b/demos/actors/robotscanner.scm
@@ -113,7 +113,7 @@
 
   (actions
    #:allocation #:each-subclass
-   #:init-value
+   #:init-thunk
    (build-actions
     (set-next-room
      (lambda* (actor message #:key id)
@@ -158,7 +158,7 @@
 
   (actions
    #:allocation #:each-subclass
-   #:init-value
+   #:init-thunk
    (build-actions
     (register-with-room
      (lambda (actor message)
diff --git a/doc/8sync.texi b/doc/8sync.texi
index 1d9e4af..67eba86 100644
--- a/doc/8sync.texi
+++ b/doc/8sync.texi
@@ -440,7 +440,7 @@ How about an actor that start sleeping, and keeps sleeping?
 
 (define-class <sleeper> (<actor>)
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (*init* sleeper-loop))))
 
 (define (sleeper-loop actor message)
@@ -457,9 +457,12 @@ How about an actor that start sleeping, and keeps sleeping?
 We see some particular things in this example.
 One thing is that our @verb{~<sleeper>~} actor has an actions slot.
 This is used to look up what the "action handler" for a message is.
-We have to set the #:allocation to either @verb{~#:each-subclass~} or
-@verb{~#:class~}.@footnote{#:class should be fine, except there is @uref{https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25211,a bug in Guile} which keeps
-us from using it for now.}
+We have to set the #:allocation to either @verb{~#:each-subclass~}
+and use @verb{~#:init-thunk~}.@footnote{@verb{~build-subclass~} returns
+a thunk to be called later so that each subclass may correctly build
+its own instance.  This is important because the structure returned
+contains a cache, which may vary from subclass to subclass based on
+its inheritance structure.}
 
 The only action handler we've added is for @verb{~*init*~}, which is called
 implicitly when the actor first starts up.
diff --git a/tests/test-actors.scm b/tests/test-actors.scm
index 0b9adb5..30f13d0 100644
--- a/tests/test-actors.scm
+++ b/tests/test-actors.scm
@@ -184,7 +184,7 @@ customer> Whaaaaat?  I can't believe I got voice mail!\n"
   (create-friend #:init-value #f
                  #:init-keyword #:create-friend)
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (*init* hi-on-init-init))))
 
 (define (hi-on-init-init actor message)
diff --git a/tests/test-rmeta-slot.scm b/tests/test-rmeta-slot.scm
index 0fd4b6f..46d30db 100644
--- a/tests/test-rmeta-slot.scm
+++ b/tests/test-rmeta-slot.scm
@@ -27,8 +27,8 @@
 ;; Define a class
 (define-class <kah-lassy> ()
   (entries #:allocation #:each-subclass
-           #:init-value
-           (make-rmeta-slot
+           #:init-thunk
+           (wrap-rmeta-slot
             `((foo . "bar")
               (baz . "basil")))))
 
@@ -41,8 +41,8 @@
 
 (define-class <sub-lassy> (<kah-lassy>)
   (entries #:allocation #:each-subclass
-           #:init-value
-           (make-rmeta-slot
+           #:init-thunk
+           (wrap-rmeta-slot
             `((foo . "foo2")
               (peanut . "gallery")))))