build-actions
- define-simple-actor
+ define-actor
<hive>
make-hive
;;; Actor utilities
;;; ===============
-(define-syntax-rule (define-simple-actor class action ...)
- (define-class class (<actor>)
+(define-syntax-rule (define-actor class inherits
+ (action ...)
+ slots ...)
+ (define-class class inherits
(actions #:init-value (build-actions action ...)
- #:allocation #:each-subclass)))
+ #:allocation #:each-subclass)
+ slots ...))
\f
;;; The Hive
(5 0)
(2 1)))
-(define-simple-actor <overseer>
- (init-world
- (lambda (actor message)
- ;; Porting mostly straight up from super-imperative XUDD code.
- (define previous-room #f)
- (define first-room #f)
-
- ;; Set up all rooms
- (for-each
- (match-lambda
- ((clean-droids infected-droids)
- ;; Create this room
- (define room (create-actor* actor <warehouse-room> "room"))
- (define* (init-droid #:key infected)
- (define droid (create-actor* actor <droid> "droid"
- #:infected infected
- #:room room))
- (<-wait droid 'register-with-room))
-
- ;; Link rooms.
- ;; Couldn't this just be folded into the warehouse room init?
- ;; I guess it stress tests more the message sending process
- (when previous-room
- (<- previous-room 'set-next-room
- #:id room)
- (<- room 'set-previous-room
- #:id previous-room))
-
- ;; Set up clean droids in the room
- (for-each
- (lambda _
- (init-droid #:infected #f))
- (iota clean-droids))
-
- ;; Set up infected droids in the room
- (for-each
- (lambda _
- (init-droid #:infected #t))
- (iota clean-droids))
-
- (set! previous-room room)
- (if (not first-room)
- (set! first-room room))))
- room-structure)
-
- ;; Add security robot
- (let ((security-robot
- (create-actor actor <security-robot>)))
- (<- security-robot 'begin-mission
- #:starting-room first-room
- #:overseer (actor-id actor)))))
-
- (transmission
- (lambda* (actor message #:key text)
- (display text)
- (newline))))
+(define-actor <overseer> (<actor>)
+ ((init-world
+ (lambda (actor message)
+ ;; Porting mostly straight up from super-imperative XUDD code.
+ (define previous-room #f)
+ (define first-room #f)
+
+ ;; Set up all rooms
+ (for-each
+ (match-lambda
+ ((clean-droids infected-droids)
+ ;; Create this room
+ (define room (create-actor* actor <warehouse-room> "room"))
+ (define* (init-droid #:key infected)
+ (define droid (create-actor* actor <droid> "droid"
+ #:infected infected
+ #:room room))
+ (<-wait droid 'register-with-room))
+
+ ;; Link rooms.
+ ;; Couldn't this just be folded into the warehouse room init?
+ ;; I guess it stress tests more the message sending process
+ (when previous-room
+ (<- previous-room 'set-next-room
+ #:id room)
+ (<- room 'set-previous-room
+ #:id previous-room))
+
+ ;; Set up clean droids in the room
+ (for-each
+ (lambda _
+ (init-droid #:infected #f))
+ (iota clean-droids))
+
+ ;; Set up infected droids in the room
+ (for-each
+ (lambda _
+ (init-droid #:infected #t))
+ (iota clean-droids))
+
+ (set! previous-room room)
+ (if (not first-room)
+ (set! first-room room))))
+ room-structure)
+
+ ;; Add security robot
+ (let ((security-robot
+ (create-actor actor <security-robot>)))
+ (<- security-robot 'begin-mission
+ #:starting-room first-room
+ #:overseer (actor-id actor)))))
+
+ (transmission
+ (lambda* (actor message #:key text)
+ (display text)
+ (newline)))))
;;; A room full of robots.
;;; Security robot... designed to seek out and destroy infected droids.
-(define-simple-actor <security-robot>
- (begin-mission security-robot-begin-mission))
+(define-actor <security-robot> (<actor>)
+ ((begin-mission security-robot-begin-mission)))
(define* (security-robot-begin-mission actor message
#:key starting-room overseer)
(use-modules (8sync actors)
(oop goops))
-(define-simple-actor <emo>
- (greet-proog
- (lambda (actor message target)
- (display "emo> What's next, Proog?\n")
- (<- target 'greet-emo))))
+(define-actor <emo> (<actor>)
+ ((greet-proog
+ (lambda (actor message target)
+ (display "emo> What's next, Proog?\n")
+ (<- target 'greet-emo)))))
-(define-simple-actor <proog>
- (greet-emo
- (lambda (actor message)
- (display "proog> Listen, Emo! Listen to the sounds of the machine!\n"))))
+(define-actor <proog> (<actor>)
+ ((greet-emo
+ (lambda (actor message)
+ (display "proog> Listen, Emo! Listen to the sounds of the machine!\n")))))
(define hive (make-hive))
(define our-emo (bootstrap-actor hive <emo>))
;;; Test reply / autoreply
;;; ======================
-(define-simple-actor <antsy-caller>
- (pester-rep (wrap-apply antsy-caller-pester-rep)))
+(define-actor <antsy-caller> (<actor>)
+ ((pester-rep (wrap-apply antsy-caller-pester-rep))))
(define* (antsy-caller-pester-rep actor message #:key who-to-call)
(~display "customer> I'm calling customer service about this!\n")
(~display "customer> Well then! Harumph.\n")
(error "Not an autoreply? What's going on here...")))))))
-(define-simple-actor <diligent-rep>
- (field-call (wrap-apply rep-field-call)))
+(define-actor <diligent-rep> (<actor>)
+ ((field-call (wrap-apply rep-field-call))))
(define (rep-field-call actor message)
(~display "good-rep> Hm, another call from a customer...\n")
(~format "*rep hears*: ~a\n" msg)
(~display "good-rep> I'm sorry, that's all I can do for you.\n")))
-(define-simple-actor <lazy-rep>
- (field-call
- (lambda (actor message)
- (~display "lazy-rep> I'm not answering that.\n"))))
+(define-actor <lazy-rep> (<actor>)
+ ((field-call
+ (lambda (actor message)
+ (~display "lazy-rep> I'm not answering that.\n")))))
(let* ((hive (make-hive))
(customer (bootstrap-actor* hive <antsy-caller> "antsy-caller"))
\f
;;; Cleanup tests
-(define-simple-actor <cleanly>
- (*cleanup* test-call-cleanup))
+(define-actor <cleanly> (<actor>)
+ ((*cleanup* test-call-cleanup)))
(define (test-call-cleanup actor message)
(speak "Hey, I'm cleanin' up here!\n"))
;; The exploder self-destructs, even though run-hive has cleanup
;; disabled, because it cleans up on self-destruct.
-(define-simple-actor <exploder>
- (explode (lambda (exploder message)
- (speak "POOF\n")
- (self-destruct exploder)))
- (*cleanup* (lambda _ (speak "Cleaning up post-explosion\n"))))
+(define-actor <exploder> (<actor>)
+ ((explode (lambda (exploder message)
+ (speak "POOF\n")
+ (self-destruct exploder)))
+ (*cleanup* (lambda _ (speak "Cleaning up post-explosion\n")))))
(with-fresh-speaker
(let ((hive (make-hive)))
projects / 8sync.git / commitdiff