From 063be529581b7004dae5ecb106bcf33729b9fef7 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 3 Jan 2017 19:57:50 -0600 Subject: [PATCH] actors: Add auto-init feature to actors. * 8sync/actors.scm (): Add '*init* action to actions slot. (, 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. --- 8sync/actors.scm | 62 +++++++++++++++++++++-------- 8sync/debug.scm | 16 ++++---- demos/actors/botherbotherbother.scm | 6 +-- demos/actors/robotscanner.scm | 2 +- demos/actors/simplest-possible.scm | 4 +- demos/ircbot.scm | 14 +++---- doc/8sync-new-manual.org | 30 +++++++------- tests/test-actors.scm | 38 ++++++++++++++---- 8 files changed, 112 insertions(+), 60 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index 6e772c6..1f5bd3c 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -58,7 +58,7 @@ ;; 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 @@ -336,6 +336,8 @@ to come after class definition." ;; 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)) @@ -433,17 +435,36 @@ to come after class definition." ;; 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 ) 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 ) message) "Handle an ambassador failing to forward a message" 'TODO) (define-method (hive-handle-cleanup-all (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))) @@ -658,31 +679,36 @@ to come after class definition." (hash-set! (hive-actor-registry hive) (actor-id actor) actor)) (define-method (%hive-create-actor (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 @@ -716,22 +742,22 @@ common case when waiting on a reply from some action invocation." ;; 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)) @@ -755,7 +781,9 @@ its '*cleanup* action handler." (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))) diff --git a/8sync/debug.scm b/8sync/debug.scm index a05f131..27438e5 100644 --- a/8sync/debug.scm +++ b/8sync/debug.scm @@ -22,8 +22,8 @@ #:export (hive-resolve-local-actor actor-hive - hive-create-actor-gimmie - hive-create-actor-gimmie*)) + bootstrap-actor-gimmie + bootstrap-actor-gimmie*)) ;;; Expose not normally exposed methods @@ -42,16 +42,16 @@ ;;; 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))) diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm index 2e72b2d..abccd4e 100755 --- a/demos/actors/botherbotherbother.scm +++ b/demos/actors/botherbotherbother.scm @@ -111,14 +111,14 @@ (define (main . args) (define agenda (make-agenda)) (define hive (make-hive)) - (define professor (hive-create-actor* hive "prof")) + (define professor (bootstrap-actor* hive "prof")) (define namegen (student-name-generator)) (define students (map (lambda _ (let ((name (namegen))) - (hive-create-actor* hive name - #:name name))) + (bootstrap-actor* hive name + #:name name))) (iota num-students))) ;; Bootstrap each student into bothering-professor mode. diff --git a/demos/actors/robotscanner.scm b/demos/actors/robotscanner.scm index d2c919c..0b32b36 100644 --- a/demos/actors/robotscanner.scm +++ b/demos/actors/robotscanner.scm @@ -261,7 +261,7 @@ (define (main . args) (define hive (make-hive)) - (define overseer (hive-create-actor hive )) + (define overseer (bootstrap-actor hive )) (define initial-messages (list (bootstrap-message hive overseer 'init-world))) (run-hive hive initial-messages)) diff --git a/demos/actors/simplest-possible.scm b/demos/actors/simplest-possible.scm index 4e03782..7743ccb 100644 --- a/demos/actors/simplest-possible.scm +++ b/demos/actors/simplest-possible.scm @@ -31,8 +31,8 @@ (display "proog> Listen, Emo! Listen to the sounds of the machine!\n")))) (define hive (make-hive)) -(define our-emo (hive-create-actor hive )) -(define our-proog (hive-create-actor hive )) +(define our-emo (bootstrap-actor hive )) +(define our-proog (bootstrap-actor hive )) (define (main . args) (run-hive hive (list (bootstrap-message hive our-emo 'greet-proog diff --git a/demos/ircbot.scm b/demos/ircbot.scm index 1c4ae74..c1c573e 100755 --- a/demos/ircbot.scm +++ b/demos/ircbot.scm @@ -104,17 +104,17 @@ (repl #f)) (define hive (make-hive)) (define irc-bot - (hive-create-actor* hive "irc-bot" - #:username username - #:server server - #:channels channels)) + (bootstrap-actor* hive "irc-bot" + #:username username + #:server server + #:channels channels)) (define repl-manager (cond ((string? repl) - (hive-create-actor* hive "repl" - #:path repl)) + (bootstrap-actor* hive "repl" + #:path repl)) (repl - (hive-create-actor* hive "repl")))) + (bootstrap-actor* hive "repl")))) (define initial-messages (if repl diff --git a/doc/8sync-new-manual.org b/doc/8sync-new-manual.org index dd8ad50..ebbd13a 100644 --- a/doc/8sync-new-manual.org +++ b/doc/8sync-new-manual.org @@ -161,22 +161,22 @@ yet. Time to fix that! (channels '("##botchat"))) (define hive (make-hive)) (define irc-bot - (hive-create-actor* hive "irc-bot" - #:username username - #:server server - #:channels channels)) + (bootstrap-actor* hive "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 @@ -426,12 +426,12 @@ Redefine run-bot like so: (repl-path "/tmp/8sync-repl")) (define hive (make-hive)) (define irc-bot - (hive-create-actor* hive "irc-bot" - #:username username - #:server server - #:channels channels)) + (bootstrap-actor* hive "irc-bot" + #:username username + #:server server + #:channels channels)) (define repl-manager - (hive-create-actor* hive "repl" + (bootstrap-actor* hive "repl" #:path repl-path)) (run-hive hive (list (bootstrap-message hive irc-bot 'init) @@ -573,7 +573,7 @@ How about an actor that start sleeping, and keeps sleeping? (8sleep 1))) (let* ((hive (make-hive)) - (sleeper (hive-create-actor hive ))) + (sleeper (bootstrap-actor hive ))) (run-hive hive (list (bootstrap-message hive sleeper 'loop)))) #+END_SRC @@ -661,9 +661,9 @@ Looks like there's nothing left to do but run it: #+BEGIN_SRC scheme (let* ((hive (make-hive)) - (worker (hive-create-actor hive )) - (manager (hive-create-actor hive - #:direct-report worker))) + (worker (bootstrap-actor hive )) + (manager (bootstrap-actor hive + #:direct-report worker))) (run-hive hive (list (bootstrap-message hive manager 'assign-task 5)))) #+END_SRC diff --git a/tests/test-actors.scm b/tests/test-actors.scm index 54d8dbb..ad81142 100644 --- a/tests/test-actors.scm +++ b/tests/test-actors.scm @@ -108,9 +108,9 @@ (~display "lazy-rep> I'm not answering that.\n")))) (let* ((hive (make-hive)) - (customer (hive-create-actor* hive "antsy-caller")) - (diligent-rep (hive-create-actor* hive "diligent-rep")) - (lazy-rep (hive-create-actor* hive "lazy-rep"))) + (customer (bootstrap-actor* hive "antsy-caller")) + (diligent-rep (bootstrap-actor* hive "diligent-rep")) + (lazy-rep (bootstrap-actor* hive "lazy-rep"))) ;; * Playing a tape of a diligent service rep * (parameterize ((%record-out (open-output-string))) (let* ((result (run-hive @@ -148,7 +148,7 @@ customer> Whaaaaat? I can't believe I got voice mail!\n" (with-fresh-speaker (let ((hive (make-hive))) - (hive-create-actor hive ) + (bootstrap-actor hive ) (run-hive hive '())) (test-equal '("Hey, I'm cleanin' up here!\n") (get-spoken))) @@ -157,7 +157,7 @@ customer> Whaaaaat? I can't believe I got voice mail!\n" (with-fresh-speaker (let ((hive (make-hive))) - (hive-create-actor hive ) + (bootstrap-actor hive ) (run-hive hive '() #:cleanup #f)) (test-equal '() (get-spoken))) @@ -173,11 +173,35 @@ customer> Whaaaaat? I can't believe I got voice mail!\n" (with-fresh-speaker (let ((hive (make-hive))) - (define exploder (hive-create-actor hive )) + (define exploder (bootstrap-actor hive )) (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 () + (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 #:name friend-name)))) +(with-fresh-speaker + (let ((hive (make-hive))) + (define hi-on-init (bootstrap-actor hive + #: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) -- 2.31.1