message-auto-reply?
- <- <-wait <-wait* <-reply <-reply-wait <-reply-wait*
+ <- <-* <-wait <-wait* <-reply <-reply* <-reply-wait <-reply-wait*
call-with-message msg-receive msg-val
;; confusing.
(8sync (hive-process-message hive new-message)))))
-
-(define (<- from-actor to-id action . message-body-args)
+(define (<- to-id action . message-body-args)
"Send a message from an actor to another actor"
- (send-message '() from-actor to-id action
+ (send-message '() (%current-actor) to-id action
#f #f message-body-args))
-(define (<-wait* send-options from-actor to-id action . message-body-args)
- "Like <-wait, but allows extra parameters, for example whether to
-#:accept-errors"
- (apply wait-maybe-handle-errors
- (send-message send-options from-actor to-id action
- #f #t message-body-args)
- send-options))
+(define (<-* send-options to-id action . message-body-args)
+ "Like <-*, but allows extra parameters via send-options"
+ (define* (really-send #:key (actor (%current-actor))
+ #:allow-other-keys)
+ (send-message send-options actor to-id action
+ #f #f message-body-args))
+ (apply really-send send-options))
-(define (<-wait from-actor to-id action . message-body-args)
+(define (<-wait to-id action . message-body-args)
"Send a message from an actor to another, but wait until we get a response"
- (apply <-wait* '() from-actor to-id action message-body-args))
+ (wait-maybe-handle-errors
+ (send-message '() (%current-actor) to-id action
+ #f #t message-body-args)))
+
+(define (<-wait* send-options to-id action . message-body-args)
+ "Like <-wait, but allows extra parameters, for example whether to
+#:accept-errors"
+ (define* (really-send #:key (actor (%current-actor))
+ #:allow-other-keys)
+ (apply wait-maybe-handle-errors
+ (send-message send-options actor to-id action
+ #f #t message-body-args)
+ send-options))
+ (apply really-send send-options))
;; TODO: Intelligently ~propagate(ish) errors on -wait functions.
;; We might have `send-message-wait-brazen' to allow callers to
;; not have an exception thrown and instead just have a message with
;; the appropriate '*error* message returned.
-(define (<-reply from-actor original-message . message-body-args)
+(define (<-reply original-message . message-body-args)
"Reply to a message"
- (send-message '() from-actor (message-from original-message) '*reply*
+ (send-message '() (%current-actor) (message-from original-message) '*reply*
original-message #f message-body-args))
-(define (<-auto-reply from-actor original-message)
+(define (<-reply* send-options original-message . message-body-args)
+ "Like <-reply, but allows extra parameters via send-options"
+ (define* (really-send #:key (actor (%current-actor))
+ #:allow-other-keys)
+ (send-message send-options actor
+ (message-from original-message) '*reply*
+ original-message #f message-body-args))
+ (apply really-send send-options))
+
+(define (<-auto-reply actor original-message)
"Auto-reply to a message. Internal use only!"
- (send-message '() from-actor (message-from original-message) '*auto-reply*
+ (send-message '() actor (message-from original-message) '*auto-reply*
original-message #f '()))
-(define (<-reply-wait* send-options from-actor original-message
- . message-body-args)
+(define (<-reply-wait original-message . message-body-args)
"Reply to a messsage, but wait until we get a response"
- (apply wait-maybe-handle-errors
- (send-message send-options from-actor
- (message-from original-message) '*reply*
- original-message #t message-body-args)
- send-options))
+ (wait-maybe-handle-errors
+ (send-message '() (%current-actor)
+ (message-from original-message) '*reply*
+ original-message #t message-body-args)))
-(define (<-reply-wait from-actor original-message . message-body-args)
- "Reply to a messsage, but wait until we get a response"
- (apply <-reply-wait* '() from-actor original-message message-body-args))
+(define (<-reply-wait* send-options original-message
+ . message-body-args)
+ "Like <-reply-wait, but allows extra parameters via send-options"
+ (define* (really-send #:key (actor (%current-actor))
+ #:allow-other-keys)
+ (apply wait-maybe-handle-errors
+ (send-message send-options actor
+ (message-from original-message) '*reply*
+ original-message #t message-body-args)
+ send-options))
+ (apply really-send send-options))
(define* (wait-maybe-handle-errors message
#:key accept-errors
(hash-map->list (lambda (actor-id actor) actor-id)
(hive-actor-registry hive)))
(for-each (lambda (actor-id)
- (<- hive actor-id '*cleanup*))
+ (<- actor-id '*cleanup*))
actor-ids))
(define* (make-hive #:key hive-id)
Unless #:cleanup is set to #f, this will first have the actor handle
its '*cleanup* action handler."
(when cleanup
- (<-wait actor (actor-id actor) '*cleanup*))
+ (<-wait (actor-id actor) '*cleanup*))
(hash-remove! (hive-actor-registry (actor-hive actor))
(actor-id actor)))
(define (bootstrap-message hive to-id action . message-body-args)
(wrap
- (apply <- hive to-id action message-body-args)))
+ (apply <-* `(#:actor ,hive) to-id action message-body-args)))
\f
(format socket "JOIN ~a~a" channel irc-eol))
(irc-bot-channels irc-bot))
- (<- irc-bot (actor-id irc-bot) 'main-loop))
+ (<- (actor-id irc-bot) 'main-loop))
(define (irc-bot-main-loop irc-bot message)
(define socket (irc-bot-socket irc-bot))
;; 'done)
;; Otherwise, let's read till the next line!
(else
- (<- irc-bot (actor-id irc-bot) 'main-loop))))
+ (<- (actor-id irc-bot) 'main-loop))))
(define* (irc-bot-send-line-action irc-bot message
channel line #:key emote?)
(while (not (student-dead actor))
(format #t "~a: Bother bother bother!\n"
(actor-id-actor actor))
- (<- actor target
- 'be-bothered
+ (<- target 'be-bothered
#:noise "Bother bother bother!\n"))))
(be-lambda-consvardraed
(actor-id actor))
(hash-for-each
(lambda (student _)
- (<- actor student
- 'be-lambda-consvardraed)
+ (<- student 'be-lambda-consvardraed)
;; Remove student from bothering list
(hash-remove! whos-bothering student))
whos-bothering))
(define droid (create-actor* actor <droid> "droid"
#:infected infected
#:room room))
- (<-wait actor droid 'register-with-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
- (<- actor previous-room 'set-next-room
+ (<- previous-room 'set-next-room
#:id room)
- (<- actor room 'set-previous-room
+ (<- room 'set-previous-room
#:id previous-room))
;; Set up clean droids in the room
;; Add security robot
(let ((security-robot
(create-actor actor <security-robot>)))
- (<- actor security-robot 'begin-mission
+ (<- security-robot 'begin-mission
#:starting-room first-room
#:overseer (actor-id actor)))))
(get-next-room
(lambda (actor message)
"Return a reference to the link following this"
- (<-reply actor message (slot-ref actor 'next-room))))
+ (<-reply message (slot-ref actor 'next-room))))
(get-previous-room
(lambda (actor message)
"Return a reference to the link preceding this"
- (<-reply actor message (slot-ref actor 'previous-room))))
+ (<-reply message (slot-ref actor 'previous-room))))
(list-droids
(lambda (actor message)
"Return a list of all the droid ids we know of in this room"
- (<-reply actor message
+ (<-reply message
#:droid-ids (slot-ref actor 'droids))))
(register-droid
(lambda (actor message)
"Register ourselves as being in a room"
(let ((room-id (slot-ref actor 'room)))
- (<-wait actor room-id
- 'register-droid
+ (<-wait room-id 'register-droid
#:droid-id (actor-id actor))
(format #t "Droid ~a registered with room ~a\n"
(actor-id-actor actor)
(infection-expose
(lambda (actor message)
"Leak whether or not we're infected to a security droid"
- (<-reply actor message (slot-ref actor 'infected))))
+ (<-reply message (slot-ref actor 'infected))))
(get-shot
(lambda (actor message)
(alive (> new-hp 0)))
;; Set our health to the new value
(slot-set! actor 'hp new-hp)
- (<-reply actor message
+ (<-reply message
#:hp-left new-hp
#:damage-taken damage
#:alive alive)
;; Continue this whil there's still another room to investigate.
(define response)
(while room
- (<- actor overseer 'transmission
+ (<- overseer 'transmission
#:text (format #f "Entering room ~a..."
(address-actor-id room)))
;; Find all droids in this room and exterminate the infected ones.
(msg-receive (_ #:key list-droids droid-ids #:allow-other-keys)
- (<-wait actor room 'list-droids)
+ (<-wait room 'list-droids)
(for-each
(lambda (droid-id)
(cond
;; Looks like it's infected
- ((msg-val (<-wait actor droid-id 'infection-expose))
+ ((msg-val (<-wait droid-id 'infection-expose))
;; Inform that it's infected
- (<- actor overseer 'transmission
+ (<- overseer 'transmission
#:text (format #f "~a found to be infected... taking out"
(address-actor-id droid-id)))
(let ((still-alive #t))
(while still-alive
(msg-receive (response #:key alive #:allow-other-keys)
- (<-wait actor droid-id 'get-shot)
- (<- actor overseer 'transmission
+ (<-wait droid-id 'get-shot)
+ (<- overseer 'transmission
#:text (droid-status-format response))
(set! still-alive alive)))))
;; Not infected... inform and go to the next one
(else
- (<- actor overseer 'transmission
+ (<- overseer 'transmission
#:text
(format #f "~a is clean... moving on."
(address-actor-id droid-id))))))
droid-ids))
;; Switch to next room, if there is one.
- (set! room (msg-val (<-wait actor room 'get-next-room))))
+ (set! room (msg-val (<-wait room 'get-next-room))))
;; Good job everyone! Shut down the operation.
- (<- actor overseer 'transmission
+ (<- overseer 'transmission
#:text "Mission accomplished."))
(define (main . args)
(greet-proog
(lambda (actor message target)
(display "emo> What's next, Proog?\n")
- (<- actor target 'greet-emo))))
+ (<- target 'greet-emo))))
(define-simple-actor <proog>
(greet-emo
(match action
;; The classic botsnack!
("botsnack"
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
"Yippie! *does a dance!*"))
;; Return greeting
((or "hello" "hello!" "hello." "greetings" "greetings." "greetings!"
"hei" "hei." "hei!" "hi" "hi!")
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
(format #f "Oh hi ~a!" speaker)))
;; ---> Add yours here <---
;; Default
(_
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
"*stupid puppy look*"))))
;; Otherwise... just spit the output to current-output-port or whatever
(_
#+BEGIN_SRC scheme
(define-method (handle-line (irc-bot <my-irc-bot>) speaker channel
line emote?)
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
(format #f "Bawwwwk! ~a says: ~a" speaker line)))
#+END_SRC
(or (equal? str my-name)
(equal? str (string-concatenate (list my-name ":")))))
(when (looks-like-me?)
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
(format #f "Bawwwwk! ~a says: ~a" speaker line))))
#+END_SRC
(match action
;; The classic botsnack!
("botsnack"
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
"Yippie! *does a dance!*"))
;; Return greeting
((or "hello" "hello!" "hello." "greetings" "greetings." "greetings!"
"hei" "hei." "hei!" "hi" "hi!")
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
(format #f "Oh hi ~a!" speaker)))
("echo"
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
(string-join action-args " ")))
;; ---> Add yours here <---
;; Default
(_
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
"*stupid puppy look*"))))))
#+END_SRC
(or (equal? str my-name)
(equal? str (string-concatenate (list my-name ":")))))
(define (respond respond-line)
- (<- irc-bot (actor-id irc-bot) 'send-line channel
+ (<- (actor-id irc-bot) 'send-line channel
respond-line))
(match (string-split line #\space)
(((? looks-like-me? _) action action-args ...)
line emote?)
;; [... snip ...]
(define (respond respond-line)
- (<- irc-bot (actor-id irc-bot) 'send-line (pk 'channel channel)
+ (<- (actor-id irc-bot) 'send-line (pk 'channel channel)
respond-line))
;; [... snip ...]
)
line emote?)
;; [... snip ...]
(define (respond respond-line)
- (<- irc-bot (actor-id irc-bot) 'send-line
+ (<- (actor-id irc-bot) 'send-line
(if (looks-like-me? channel)
speaker ; PM session
channel) ; normal IRC channel
(define (manager-assign-task manager message difficulty)
"Delegate a task to our direct report"
(display "manager> Work on this task for me!\n")
- (<- manager (manager-direct-report manager)
+ (<- (manager-direct-report manager)
'work-on-this difficulty))
#+END_SRC
(define (manager-assign-task manager message difficulty)
"Delegate a task to our direct report"
(display "manager> Work on this task for me!\n")
- (<- manager (manager-direct-report manager)
+ (<- (manager-direct-report manager)
'work-on-this difficulty)
;; call the micromanagement loop
"Pester direct report until they're done with their task."
(display "manager> Are you done yet???\n")
(let ((still-working
- (msg-val (<-wait manager (manager-direct-report manager)
+ (msg-val (<-wait (manager-direct-report manager)
'done-yet?))))
(if still-working
(begin (display "manager> Harumph!\n")
(when (actor-alive? manager)
(manager-micromanage-loop manager)))
(begin (display "manager> Oh! I guess you can go home then.\n")
- (<- manager (manager-direct-report manager) 'go-home)))))
+ (<- (manager-direct-report manager) 'go-home)))))
#+END_SRC
We've appended a micromanagement loop here... but what's going on?
;;; New procedures:
(define (worker-done-yet? worker message)
"Reply with whether or not we're done yet."
- (<-reply worker message
+ (<-reply message
(= (worker-task-left worker) 0)))
(define (worker-go-home worker message)
(define* (antsy-caller-pester-rep actor message #:key who-to-call)
(~display "customer> I'm calling customer service about this!\n")
(msg-receive (first-reply #:key msg)
- (<-wait actor who-to-call 'field-call)
+ (<-wait who-to-call 'field-call)
(if (message-auto-reply? first-reply)
(~display "customer> Whaaaaat? I can't believe I got voice mail!\n")
(begin
(~format "*customer hears*: ~a\n" msg)
(msg-receive (second-reply #:key *auto-reply*)
- (<-reply-wait actor first-reply
+ (<-reply-wait first-reply
#:msg "Yes, it didn't work, I'm VERY ANGRY!")
(if (message-auto-reply? second-reply)
(~display "customer> Well then! Harumph.\n")
(define (rep-field-call actor message)
(~display "good-rep> Hm, another call from a customer...\n")
(msg-receive (reply #:key msg)
- (<-reply-wait
- actor message
- #:msg "Have you tried turning it off and on?")
+ (<-reply-wait message #:msg "Have you tried turning it off and on?")
(~format "*rep hears*: ~a\n" msg)
(~display "good-rep> I'm sorry, that's all I can do for you.\n")))
projects / 8sync.git / commitdiff