summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
22199a3)
mlambda is a new nice sugar for passing in arguments, so add that.
Also, various problems found with GOOPS hackery in Guile 2.2.
Cleaning up.
* 8sync/systems/actors.scm (require-slot): Removed. Doesn't work with
Guile 2.2.
(<actor>): Updated to drop usage of require-slot.
(mlambda): New procedure allowing automatically pulling out message
stuff from action method definitions.
(%expand-action-item): Use mlambda.
(<hive>): Remove redundant slot definition back to hive. The actor
already does this, and not re-supplying the accessor breaks GOOPS
in Guile 2.2.
big-random-number
big-random-number-string
simple-message-id-generator
big-random-number
big-random-number-string
simple-message-id-generator
actor-id-hive
actor-id-string
actor-id-hive
actor-id-string
make-action-dispatch
define-simple-actor
make-action-dispatch
define-simple-actor
(set! counter (1+ counter))
(string-append prefix (number->string counter)))))
(set! counter (1+ counter))
(string-append prefix (number->string counter)))))
-(define (require-slot slot-name)
- "Generate something for #:init-thunk to complain about unfilled slot"
- (lambda ()
- (throw 'required-slot
- (format #f "Slot ~s not filled" slot-name)
- slot-name)))
-
(define-class <actor> ()
;; An address object
(define-class <actor> ()
;; An address object
- (id #:init-thunk (require-slot "id")
- #:init-keyword #:id
+ (id #:init-keyword #:id
#:getter actor-id)
;; The hive we're connected to.
;; We need this to be able to send messages.
#:getter actor-id)
;; The hive we're connected to.
;; We need this to be able to send messages.
- (hive #:init-thunk (require-slot "hive")
- #:init-keyword #:hive
+ (hive #:init-keyword #:hive
#:accessor actor-hive)
;; How we receive and process new messages
#:accessor actor-hive)
;; How we receive and process new messages
- (message-handler #:init-thunk (require-slot "message-handler")
- #:allocation #:each-subclass))
+ (message-handler #:allocation #:each-subclass))
(define-method (actor-message-handler (actor <actor>))
(slot-ref actor 'message-handler))
(define-method (actor-message-handler (actor <actor>))
(slot-ref actor 'message-handler))
;;; Actor utilities
;;; ===============
;;; Actor utilities
;;; ===============
+(define-syntax mlambda
+ (syntax-rules ()
+ "A lambda for building message handlers.
+
+Use it like:
+ (mlambda (actor message foo)
+ ...)
+
+Which is like doing manually:
+ (lambda (actor message)
+ (let ((foo (message-ref message foo)))
+ ...))"
+ ((_ (actor message message-arg ...)
+ body body* ...)
+ (lambda (actor message)
+ (let ((message-arg (message-ref message (quote message-arg))) ...)
+ body body* ...)))))
+
(define (simple-dispatcher action-map)
(lambda (actor message)
(let* ((action (message-action message))
(define (simple-dispatcher action-map)
(lambda (actor message)
(let* ((action (message-action message))
(syntax-rules ()
((_ ((action-name action-args ...) body ...))
(cons (quote action-name)
(syntax-rules ()
((_ ((action-name action-args ...) body ...))
(cons (quote action-name)
- (lambda (action-args ...)
+ (mlambda (action-args ...)
body ...)))
((_ (action-name handler))
(cons (quote action-name) handler))))
body ...)))
((_ (action-name handler))
(cons (quote action-name) handler))))
(define-generic hive-handle-failed-forward)
(define-class <hive> (<actor>)
(define-generic hive-handle-failed-forward)
(define-class <hive> (<actor>)
- ;; This gets set to itself immediately after being created
- (hive #:init-value #f)
(actor-registry #:init-thunk make-hash-table
#:getter hive-actor-registry)
(msg-id-generator #:init-thunk simple-message-id-generator
(actor-registry #:init-thunk make-hash-table
#:getter hive-actor-registry)
(msg-id-generator #:init-thunk simple-message-id-generator