X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=c33240f309cc181dcf030b905a43b989e4cec186;hp=a5033135653422a8c8feb7db452a766fe9288d4c;hb=e8a99d0a22f93676617c1d7d0f45cb675ed852ee;hpb=5099eea71d7271a4237855c7d297195f36251b01 diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm index a503313..c33240f 100644 --- a/8sync/systems/actors.scm +++ b/8sync/systems/actors.scm @@ -316,6 +316,12 @@ If key not found and DFLT not provided, throw an error." ;;; Actor utilities ;;; =============== + +(define-syntax-rule (with-message-args (message message-arg ...) + body body* ...) + (let ((message-arg (message-ref message (quote message-arg))) ...) + body body* ...)) + (define-syntax mlambda (syntax-rules () "A lambda for building message handlers. @@ -331,8 +337,7 @@ Which is like doing manually: ((_ (actor message message-arg ...) body body* ...) (lambda (actor message) - (let ((message-arg (message-ref message (quote message-arg))) ...) - body body* ...))))) + (with-message-args (message message-arg ...) body body* ...))))) ;; @@: Sadly, docstrings won't work with this... ;; I think we need to bust out syntax-case to make that happen... @@ -364,6 +369,9 @@ Which is like doing manually: ((_ (action-name handler)) (cons (quote action-name) handler)))) +(define-syntax-rule (build-actions action-item ...) + (list (%expand-action-item action-item) ...)) + (define-syntax make-action-dispatch (syntax-rules () "Expand a list of action names and actions into an alist @@ -385,8 +393,7 @@ more compact following syntax: ((party actor message) (display \"Life of the party!\")))" ((make-action-dispatch action-item ...) - (simple-dispatcher - (list (%expand-action-item action-item) ...))))) + (simple-dispatcher (build-actions action-item ...))))) (define-syntax-rule (define-simple-actor class actions ...) (define-class class ()