From: Christopher Allan Webber Date: Wed, 4 Jan 2017 17:41:30 +0000 (-0600) Subject: actors: Remove define-simple-actor, add define-actor. X-Git-Tag: v0.4.0~22 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=84a19e7d4cb97e00a64191e1ecfcf984ffae52d1;p=8sync.git actors: Remove define-simple-actor, add define-actor. define-simple-actor wasn't very useful, whereas define-actor is moderately helpful. * 8sync/actors.scm (define-simple-actor): Remove. (define-actor): New macro. * demos/actors/robotscanner.scm: * demos/actors/simplest-possible.scm: * tests/test-actors.scm: Convert to use define-simple-actor instead of define-actor. --- diff --git a/8sync/actors.scm b/8sync/actors.scm index 8e1b504..1d8e602 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -51,7 +51,7 @@ build-actions - define-simple-actor + define-actor make-hive @@ -395,10 +395,13 @@ to come after class definition." ;;; Actor utilities ;;; =============== -(define-syntax-rule (define-simple-actor class action ...) - (define-class class () +(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 ...)) ;;; The Hive diff --git a/demos/actors/robotscanner.scm b/demos/actors/robotscanner.scm index 1fd3c88..5dd5d5e 100644 --- a/demos/actors/robotscanner.scm +++ b/demos/actors/robotscanner.scm @@ -47,62 +47,62 @@ (5 0) (2 1))) -(define-simple-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 "room")) - (define* (init-droid #:key infected) - (define droid (create-actor* actor "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 'begin-mission - #:starting-room first-room - #:overseer (actor-id actor))))) - - (transmission - (lambda* (actor message #:key text) - (display text) - (newline)))) +(define-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 "room")) + (define* (init-droid #:key infected) + (define droid (create-actor* actor "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 'begin-mission + #:starting-room first-room + #:overseer (actor-id actor))))) + + (transmission + (lambda* (actor message #:key text) + (display text) + (newline))))) ;;; A room full of robots. @@ -206,8 +206,8 @@ ;;; Security robot... designed to seek out and destroy infected droids. -(define-simple-actor - (begin-mission security-robot-begin-mission)) +(define-actor () + ((begin-mission security-robot-begin-mission))) (define* (security-robot-begin-mission actor message #:key starting-room overseer) diff --git a/demos/actors/simplest-possible.scm b/demos/actors/simplest-possible.scm index 7743ccb..58921fe 100644 --- a/demos/actors/simplest-possible.scm +++ b/demos/actors/simplest-possible.scm @@ -19,16 +19,16 @@ (use-modules (8sync actors) (oop goops)) -(define-simple-actor - (greet-proog - (lambda (actor message target) - (display "emo> What's next, Proog?\n") - (<- target 'greet-emo)))) +(define-actor () + ((greet-proog + (lambda (actor message target) + (display "emo> What's next, Proog?\n") + (<- target 'greet-emo))))) -(define-simple-actor - (greet-emo - (lambda (actor message) - (display "proog> Listen, Emo! Listen to the sounds of the machine!\n")))) +(define-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 )) diff --git a/tests/test-actors.scm b/tests/test-actors.scm index 4d7ec4b..0b9adb5 100644 --- a/tests/test-actors.scm +++ b/tests/test-actors.scm @@ -74,8 +74,8 @@ ;;; Test reply / autoreply ;;; ====================== -(define-simple-actor - (pester-rep (wrap-apply antsy-caller-pester-rep))) +(define-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") @@ -92,8 +92,8 @@ (~display "customer> Well then! Harumph.\n") (error "Not an autoreply? What's going on here..."))))))) -(define-simple-actor - (field-call (wrap-apply rep-field-call))) +(define-actor () + ((field-call (wrap-apply rep-field-call)))) (define (rep-field-call actor message) (~display "good-rep> Hm, another call from a customer...\n") @@ -102,10 +102,10 @@ (~format "*rep hears*: ~a\n" msg) (~display "good-rep> I'm sorry, that's all I can do for you.\n"))) -(define-simple-actor - (field-call - (lambda (actor message) - (~display "lazy-rep> I'm not answering that.\n")))) +(define-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")) @@ -140,8 +140,8 @@ customer> Whaaaaat? I can't believe I got voice mail!\n" ;;; Cleanup tests -(define-simple-actor - (*cleanup* test-call-cleanup)) +(define-actor () + ((*cleanup* test-call-cleanup))) (define (test-call-cleanup actor message) (speak "Hey, I'm cleanin' up here!\n")) @@ -165,11 +165,11 @@ customer> Whaaaaat? I can't believe I got voice mail!\n" ;; The exploder self-destructs, even though run-hive has cleanup ;; disabled, because it cleans up on self-destruct. -(define-simple-actor - (explode (lambda (exploder message) - (speak "POOF\n") - (self-destruct exploder))) - (*cleanup* (lambda _ (speak "Cleaning up post-explosion\n")))) +(define-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)))