* 8sync/actors.scm (<actor>): Add '*init* action to actions slot.
(<hive>, hive-handle-init-all): Add '*init-all* action.
(hive-handle-cleanup-all): Adjust comment.
(%hive-create-actor): Add send-init? argument, and when supplied
call <-wait on the actor's '*init* method.
(bootstrap-actor, bootstrap-actor*): Rename from hive-create-actor,
hive-create-actor*. Switch init argument to init-args and pass in #f to
%hive-create-actor's send-init? argument.
(create-actor, create-actor*): Switch init argument to init-args
and pass in #t to %hive-create-actor's send-init? argument.
(run-hive): Add '*init-all* action call to the hive on the initial
queue.
* 8sync/debug.scm (bootstrap-actor-gimmie, bootstrap-actor-gimmie*):
Rename from hive-create-actor-gimmie, hive-create-actor-gimmie*.
* demos/actors/botherbotherbother.scm:
* demos/actors/robotscanner.scm:
* demos/actors/simplest-possible.scm:
* demos/ircbot.scm:
* doc/8sync-new-manual.org:
* tests/test-actors.scm: Change calls from hive-create-actor to
bootstrap-actor.
* tests/test-actors.scm: Add actor *init*'ing tests.
;; There are more methods for the hive, but there's
;; no reason for the outside world to look at them maybe?
hive-id
- hive-create-actor hive-create-actor*
+ bootstrap-actor bootstrap-actor*
create-actor create-actor*
self-destruct
;; This is the default, "simple" way to inherit and process messages.
(actions #:init-value (build-actions
+ ;; Default init method is to do nothing.
+ (*init* (const #f))
;; Default cleanup method is to do nothing.
(*cleanup* (const #f)))
#:allocation #:each-subclass))
;; This is in the case of an ambassador failing to forward a
;; message... it reports it back to the hive
(*failed-forward* hive-handle-failed-forward)
+ ;; These are called at start and end of run-hive
+ (*init-all* hive-handle-init-all)
(*cleanup-all* hive-handle-cleanup-all))))
+(define-method (hive-handle-init-all (hive <hive>) message)
+ "Run *init* method on all actors in registry"
+ ;; We have to do this hack and run over the list
+ ;; twice, because hash-for-each would result in an unrewindable
+ ;; continuation, and to avoid the hash-map changing during the
+ ;; middle of this.
+ (define actor-ids
+ (hash-map->list (lambda (actor-id actor) actor-id)
+ (hive-actor-registry hive)))
+ (for-each (lambda (actor-id)
+ ;; @@: This could maybe just be <-, but we want actors
+ ;; to be used to the expectation in all circumstances
+ ;; that their init method is "waited on".
+ (<-wait actor-id '*init*))
+ actor-ids))
+
(define-method (hive-handle-failed-forward (hive <hive>) message)
"Handle an ambassador failing to forward a message"
'TODO)
(define-method (hive-handle-cleanup-all (hive <hive>) message)
"Send a message to all actors in our registry to clean themselves up."
- ;; Unfortunately we have to do this hack and run over the list
+ ;; We have to do this hack and run over the list
;; twice, because hash-for-each would result in an unrewindable
- ;; continuation.
+ ;; continuation, and to avoid the hash-map changing during the
+ ;; middle of this.
(define actor-ids
(hash-map->list (lambda (actor-id actor) actor-id)
(hive-actor-registry hive)))
(hash-set! (hive-actor-registry hive) (actor-id actor) actor))
(define-method (%hive-create-actor (hive <hive>) actor-class
- init id-cookie)
- "Actual method called by hive-create-actor.
+ init-args id-cookie send-init?)
+ "Actual method called by bootstrap-actor / create-actor.
Since this is a define-method it can't accept fancy define* arguments,
-so this gets called from the nicer hive-create-actor interface. See
+so this gets called from the nicer bootstrap-actor interface. See
that method for documentation."
(let* ((actor-id (hive-gen-actor-id hive id-cookie))
(actor (apply make actor-class
#:hive hive
#:id actor-id
- init)))
+ init-args)))
(hive-register-actor! hive actor)
+ ;; Wait on actor to init
+ (when send-init?
+ (<-wait actor-id '*init*))
;; return the actor id
actor-id))
-(define* (hive-create-actor hive actor-class #:rest init)
- "Create an actor on HIVE using ACTOR-CLASS passing in INIT args"
+(define* (bootstrap-actor hive actor-class #:rest init-args)
+ "Create an actor on HIVE using ACTOR-CLASS passing in INIT-ARGS args"
(%hive-create-actor hive actor-class
- init (symbol->string (class-name actor-class))))
+ init-args (symbol->string (class-name actor-class))
+ #f))
-(define* (hive-create-actor* hive actor-class id-cookie #:rest init)
+(define* (bootstrap-actor* hive actor-class id-cookie #:rest init-args)
"Create an actor, but also allow customizing a 'cookie' added to the id
for debugging"
(%hive-create-actor hive actor-class
- init id-cookie))
+ init-args id-cookie
+ #f))
(define (call-with-message message proc)
"Applies message body arguments into procedure, with message as first
;; TODO: move send-message and friends here...?
-(define* (create-actor from-actor actor-class #:rest init)
+(define* (create-actor from-actor actor-class #:rest init-args)
"Create an instance of actor-class. Return the new actor's id.
This is the method actors should call directly (unless they want
to supply an id-cookie, in which case they should use
create-actor*)."
(%hive-create-actor (actor-hive from-actor) actor-class
- init #f))
+ init-args #f #t))
-(define* (create-actor* from-actor actor-class id-cookie #:rest init)
+(define* (create-actor* from-actor actor-class id-cookie #:rest init-args)
"Create an instance of actor-class. Return the new actor's id.
Like create-actor, but permits supplying an id-cookie."
(%hive-create-actor (actor-hive from-actor) actor-class
- init id-cookie))
+ init-args id-cookie #t))
(define* (self-destruct actor #:key (cleanup #t))
(dynamic-wind
(const #f)
(lambda ()
- (let* ((queue (list->q initial-tasks))
+ (let* ((queue (list->q
+ (cons (bootstrap-message hive (actor-id hive) '*init-all*)
+ initial-tasks)))
(agenda (make-agenda #:pre-unwind-handler print-error-and-continue
#:queue queue)))
(run-agenda agenda)))
#:export (hive-resolve-local-actor
actor-hive
- hive-create-actor-gimmie
- hive-create-actor-gimmie*))
+ bootstrap-actor-gimmie
+ bootstrap-actor-gimmie*))
\f
;;; Expose not normally exposed methods
;;; Some utilities
;;; =============
-(define (hive-create-actor-gimmie hive actor-class . init)
+(define (bootstrap-actor-gimmie hive actor-class . init)
"Create an actor on the hive, and give us that actor.
-Uses hive-create-actor* arguments."
- (let ((actor-id (apply hive-create-actor hive actor-class init)))
+Uses bootstrap-actor* arguments."
+ (let ((actor-id (apply bootstrap-actor hive actor-class init)))
(hive-resolve-local-actor hive actor-id)))
-(define (hive-create-actor-gimmie* hive actor-class id-cookie . init)
+(define (bootstrap-actor-gimmie* hive actor-class id-cookie . init)
"Create an actor on the hive, and give us that actor.
-Uses hive-create-actor* arguments."
- (let ((actor-id (apply hive-create-actor*
+Uses bootstrap-actor* arguments."
+ (let ((actor-id (apply bootstrap-actor*
hive actor-class id-cookie init)))
(hive-resolve-local-actor hive actor-id)))
(define (main . args)
(define agenda (make-agenda))
(define hive (make-hive))
- (define professor (
hive-create-actor* hive <professor> "prof"))
+ (define professor (
bootstrap-actor* hive <professor> "prof"))
(define namegen (student-name-generator))
(define students
(map
(lambda _
(let ((name (namegen)))
- (hive-create-actor* hive <student> name
- #:name name)))
+ (bootstrap-actor* hive <student> name
+ #:name name)))
(iota num-students)))
;; Bootstrap each student into bothering-professor mode.
(define (main . args)
(define hive (make-hive))
- (define overseer (hive-create-actor hive <overseer>))
+ (define overseer (bootstrap-actor hive <overseer>))
(define initial-messages
(list (bootstrap-message hive overseer 'init-world)))
(run-hive hive initial-messages))
(display "proog> Listen, Emo! Listen to the sounds of the machine!\n"))))
(define hive (make-hive))
-(define our-emo (hive-create-actor hive <emo>))
-(define our-proog (
hive-create-actor hive <proog>))
+(define our-emo (bootstrap-actor hive <emo>))
+(define our-proog (
bootstrap-actor hive <proog>))
(define (main . args)
(run-hive hive
(list (bootstrap-message hive our-emo 'greet-proog
(repl #f))
(define hive (make-hive))
(define irc-bot
- (hive-create-actor* hive <my-irc-bot> "irc-bot"
- #:username username
- #:server server
- #:channels channels))
+ (bootstrap-actor* hive <my-irc-bot> "irc-bot"
+ #:username username
+ #:server server
+ #:channels channels))
(define repl-manager
(cond
((string? repl)
- (hive-create-actor* hive <repl-manager> "repl"
- #:path repl))
+ (bootstrap-actor* hive <repl-manager> "repl"
+ #:path repl))
(repl
- (hive-create-actor* hive <repl-manager> "repl"))))
+ (bootstrap-actor* hive <repl-manager> "repl"))))
(define initial-messages
(if repl
(channels '("##botchat")))
(define hive (make-hive))
(define irc-bot
- (hive-create-actor* hive <my-irc-bot> "irc-bot"
- #:username username
- #:server server
- #:channels channels))
+ (bootstrap-actor* hive <my-irc-bot> "irc-bot"
+ #:username username
+ #:server server
+ #:channels channels))
(run-hive hive (list (bootstrap-message hive irc-bot 'init))))
#+END_SRC
Actors are connected to something called a "hive", which is a
special kind of actor that runs all the other actors.
Actors can spawn other actors, but before we start the hive we use
-this special "hive-create-actor*" method.
+this special "bootstrap-actor*" method.
It takes the hive as its first argument, the actor class as the second
argument, a decorative "cookie" as the third argument (this is
optional, but it helps with debugging... you can skip it by setting it
to #f if you prefer), and the rest are initialization arguments to the
-actor. hive-create-actor* passes back not the actor itself (we don't
+actor. bootstrap-actor* passes back not the actor itself (we don't
get access to that usually) but the *id* of the actor.
(More on this later.)
Finally we run the hive with run-hive and pass it a list of
(repl-path "/tmp/8sync-repl"))
(define hive (make-hive))
(define irc-bot
- (hive-create-actor* hive <my-irc-bot> "irc-bot"
- #:username username
- #:server server
- #:channels channels))
+ (bootstrap-actor* hive <my-irc-bot> "irc-bot"
+ #:username username
+ #:server server
+ #:channels channels))
(define repl-manager
- (hive-create-actor* hive <repl-manager> "repl"
+ (bootstrap-actor* hive <repl-manager> "repl"
#:path repl-path))
(run-hive hive (list (bootstrap-message hive irc-bot 'init)
(8sleep 1)))
(let* ((hive (make-hive))
- (sleeper (hive-create-actor hive <sleeper>)))
+ (sleeper (bootstrap-actor hive <sleeper>)))
(run-hive hive (list (bootstrap-message hive sleeper 'loop))))
#+END_SRC
#+BEGIN_SRC scheme
(let* ((hive (make-hive))
- (worker (hive-create-actor hive <worker>))
- (manager (hive-create-actor hive <manager>
- #:direct-report worker)))
+ (worker (bootstrap-actor hive <worker>))
+ (manager (bootstrap-actor hive <manager>
+ #:direct-report worker)))
(run-hive hive (list (bootstrap-message hive manager 'assign-task 5))))
#+END_SRC
(~display "lazy-rep> I'm not answering that.\n"))))
(let* ((hive (make-hive))
- (customer (
hive-create-actor* hive <antsy-caller> "antsy-caller"))
- (diligent-rep (hive-create-actor* hive <diligent-rep> "diligent-rep"))
- (lazy-rep (hive-create-actor* hive <lazy-rep> "lazy-rep")))
+ (customer (
bootstrap-actor* hive <antsy-caller> "antsy-caller"))
+ (diligent-rep (bootstrap-actor* hive <diligent-rep> "diligent-rep"))
+ (lazy-rep (bootstrap-actor* hive <lazy-rep> "lazy-rep")))
;; * Playing a tape of a diligent service rep *
(parameterize ((%record-out (open-output-string)))
(let* ((result (run-hive
(with-fresh-speaker
(let ((hive (make-hive)))
- (hive-create-actor hive <cleanly>)
+ (bootstrap-actor hive <cleanly>)
(run-hive hive '()))
(test-equal '("Hey, I'm cleanin' up here!\n")
(get-spoken)))
(with-fresh-speaker
(let ((hive (make-hive)))
- (hive-create-actor hive <cleanly>)
+ (bootstrap-actor hive <cleanly>)
(run-hive hive '() #:cleanup #f))
(test-equal '()
(get-spoken)))
(with-fresh-speaker
(let ((hive (make-hive)))
- (define exploder (hive-create-actor hive <exploder>))
+ (define exploder (bootstrap-actor hive <exploder>))
(run-hive hive (list (bootstrap-message hive exploder 'explode))
#:cleanup #f))
- (get-spoken))
+ (test-equal '("POOF\n" "Cleaning up post-explosion\n")
+ (get-spoken)))
+
+(define-class <hi-on-init> (<actor>)
+ (name #:init-keyword #:name)
+ (create-friend #:init-value #f
+ #:init-keyword #:create-friend)
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (*init* hi-on-init-init))))
+
+(define (hi-on-init-init actor message)
+ (speak (format #f "Hi! ~a inits now.\n"
+ (slot-ref actor 'name)))
+ (and=> (slot-ref actor 'create-friend)
+ (lambda (friend-name)
+ (create-actor actor <hi-on-init> #:name friend-name))))
+(with-fresh-speaker
+ (let ((hive (make-hive)))
+ (define hi-on-init (bootstrap-actor hive <hi-on-init>
+ #:name "jack"
+ #:create-friend "jill"))
+ (run-hive hive '()))
+ (test-equal (get-spoken)
+ '("Hi! jack inits now.\n" "Hi! jill inits now.\n")))
(test-end "test-actors")
(test-exit)
projects / 8sync.git / commitdiff