summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Allan Webber <cwebber@dustycloud.org>2017-01-25 11:42:20 -0600
committerChristopher Allan Webber <cwebber@dustycloud.org>2017-01-25 11:42:20 -0600
commit8bdfa5c8f81d4e46d57c367da23cd8ea676ad717 (patch)
tree810b0f68cd781205dad0540211032be8e3f47b99
parentc32aa0d308ce33667168dc2c2f41b30f423fe158 (diff)
download8sync-8bdfa5c8f81d4e46d57c367da23cd8ea676ad717.tar.gz
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.
-rw-r--r--8sync/actors.scm8
-rw-r--r--8sync/rmeta-slot.scm16
-rwxr-xr-x8sync/systems/irc.scm2
-rw-r--r--demos/actors/robotscanner.scm4
-rw-r--r--doc/8sync.texi11
-rw-r--r--tests/test-actors.scm2
-rw-r--r--tests/test-rmeta-slot.scm8
7 files changed, 30 insertions, 21 deletions
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")))))