From 1253ea73ba4020df78671955721721179b556bfc Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 1 Aug 2017 11:30:38 -0500 Subject: [PATCH] Update reference to hive to be dynamic state, simplify create-actor. This also eliminates bootstrap-actor. * 8sync/actors.scm (, actor-hive-channel): Removed hive-channel slot from . (*hive-id*, *hive-channel*): New variables. (spawn-hive): Update to parameterize *hive-id* and *hive-channel*. (%create-actor): No longer take hive-channel and hive-id as arguments. (bootstrap-actor, bootstrap-actor*): Removed since these are now unified with create-actor. (create-actor, create-actor*): Updated to remove argument of from-actor and update argument calls to %create-actor. (self-destruct): Use *hive-channel* parameter. * demos/actors/botherbotherbother.scm: * demos/actors/robotscanner.scm: * demos/actors/simplest-possible.scm: Update calls to create-actor and remove bootstrap-actor references. --- 8sync/actors.scm | 50 +++++++++++------------------ demos/actors/botherbotherbother.scm | 9 +++--- demos/actors/robotscanner.scm | 9 +++--- demos/actors/simplest-possible.scm | 5 ++- 4 files changed, 29 insertions(+), 44 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index d12427e..ca8a55f 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -71,8 +71,6 @@ ;; ;; There are more methods for the hive, but there's ;; ;; no reason for the outside world to look at them maybe? ;; hive-id - bootstrap-actor bootstrap-actor* - create-actor create-actor* self-destruct @@ -242,9 +240,6 @@ to come after class definition." ;; kicks the bucket (id #:init-keyword #:address #:getter actor-id) - ;; The connection to the hive we're connected to. - (hive-channel #:init-keyword #:hive-channel - #:accessor actor-hive-channel) ;; Our queue to send/receive messages on (inbox-deq #:init-thunk make-channel @@ -525,6 +520,7 @@ dynamic context." ;;; Every actor has a hive, which keeps track of other actors, manages ;;; cleanup, and performs inter-hive communication. +;; TODO: Make this a srfi-9 record type (define-class () (id #:init-keyword #:id #:getter hive-id) @@ -588,12 +584,17 @@ values, the first value being a symbol" (and (perform-operation halt-or-handle) (lp)))) -(define *current-hive* (make-parameter #f)) +(define *hive-id* (make-parameter #f)) +(define *hive-channel* (make-parameter #f)) +;; @@: Should we halt the hive either at the end of spawn-hive or run-hive? (define* (spawn-hive proc #:key (hive (make-hive))) - "Spawn a hive in a fiber running PROC, passing it the fresh hive" + "Spawn a hive and run PROC, passing it the fresh hive and establishing +a dynamic context surrounding the hive." (spawn-fiber (lambda () (hive-main-loop hive))) - (proc hive)) + (parameterize ((*hive-id* (hive-id hive)) + (*hive-channel* (hive-channel hive))) + (proc hive))) (define (run-hive proc . args) "Spawn a hive and run it in run-fibers. Takes a PROC as would be passed @@ -603,15 +604,15 @@ to spawn-hive... all remaining arguments passed to run-fibers." (spawn-hive proc)) args)) -(define (%create-actor hive-channel hive-id - actor-class init-args id-cookie send-init?) - (let* ((actor-id (gen-actor-id id-cookie)) +(define (%create-actor actor-class init-args id-cookie send-init?) + (let* ((hive-channel (*hive-channel*)) + (hive-id (*hive-id*)) + (actor-id (gen-actor-id id-cookie)) (dead? (make-condition)) (inbox-enq (make-channel)) (address (make-address actor-id hive-id inbox-enq dead?)) (actor (apply make actor-class - #:hive-channel hive-channel #:address address init-args)) (should-init (actor-should-init actor))) @@ -635,35 +636,20 @@ to spawn-hive... all remaining arguments passed to run-fibers." ;; return the address address)) -(define* (bootstrap-actor hive actor-class #:rest init-args) - "Create an actor on HIVE using ACTOR-CLASS passing in INIT-ARGS args" - (%create-actor (hive-channel hive) (hive-id hive) actor-class - init-args (symbol->string (class-name actor-class)) - #f)) - -(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" - (%create-actor (hive-channel hive) (hive-id hive) actor-class - init-args id-cookie - #f)) - -(define* (create-actor from-actor actor-class #:rest init-args) +(define* (create-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*)." - (%create-actor (actor-hive-channel from-actor) (actor-id-hive from-actor) - actor-class init-args #f #t)) + (%create-actor actor-class init-args #f #t)) -(define* (create-actor* from-actor actor-class id-cookie #:rest init-args) +(define* (create-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." - (%create-actor (actor-hive-channel from-actor) (actor-id-hive from-actor) - actor-class init-args id-cookie #t)) + (%create-actor actor-class init-args id-cookie #t)) (define* (self-destruct actor #:key (cleanup #t)) "Remove an actor from the hive. @@ -671,7 +657,7 @@ Like create-actor, but permits supplying an id-cookie." Unless #:cleanup is set to #f, this will first have the actor handle its '*cleanup* action handler." (signal-condition! (address-dead? (actor-id actor))) - (put-message (actor-hive-channel actor) (list 'remove-actor (actor-id-actor actor))) + (put-message (*hive-channel*) (list 'remove-actor (actor-id-actor actor))) ;; Set *actor-prompt* to nothing to prevent actor-cleanup! from sending ;; a message with <-wait (*actor-prompt* #f) diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm index 69f3190..57b20ff 100755 --- a/demos/actors/botherbotherbother.scm +++ b/demos/actors/botherbotherbother.scm @@ -25,7 +25,8 @@ (use-modules (8sync actors) (oop goops) (ice-9 hash-table) - (ice-9 format)) + (ice-9 format) + (fibers conditions)) (set! *random-state* (random-state-from-platform)) (define (random-choice lst) @@ -104,14 +105,14 @@ (define (main . args) (run-hive (lambda (hive) - (define professor (bootstrap-actor* hive "prof")) + (define professor (create-actor* "prof")) (define namegen (student-name-generator)) (define students (map (lambda _ (let ((name (namegen))) - (bootstrap-actor* hive name - #:name name))) + (create-actor* 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 52f96e0..256b3a3 100644 --- a/demos/actors/robotscanner.scm +++ b/demos/actors/robotscanner.scm @@ -60,9 +60,9 @@ (match-lambda ((clean-droids infected-droids) ;; Create this room - (define room (create-actor* actor "room")) + (define room (create-actor* "room")) (define* (init-droid #:key infected) - (define droid (create-actor* actor "droid" + (define droid (create-actor* "droid" #:infected infected #:room room)) (<-wait droid 'register-with-room)) @@ -95,7 +95,7 @@ ;; Add security robot (let ((security-robot - (create-actor actor ))) + (create-actor ))) (<- security-robot 'begin-mission #:starting-room first-room #:overseer (actor-id actor))))) @@ -265,7 +265,6 @@ (run-hive (lambda (hive) (define done? (make-condition)) - (define overseer (bootstrap-actor hive - #:done? done?)) + (define overseer (create-actor #:done? done?)) (<- overseer 'init-world) (wait done?)))) diff --git a/demos/actors/simplest-possible.scm b/demos/actors/simplest-possible.scm index 1b649dc..c1e8125 100644 --- a/demos/actors/simplest-possible.scm +++ b/demos/actors/simplest-possible.scm @@ -38,8 +38,7 @@ (run-hive (lambda (hive) (define done? (make-condition)) - (define our-emo (bootstrap-actor hive )) - (define our-proog (bootstrap-actor hive - #:done? done?)) + (define our-emo (create-actor )) + (define our-proog (create-actor #:done? done?)) (<- our-emo 'greet-proog our-proog) (wait done?)))) -- 2.31.1