actors: Add build-actions and retool make-action-dispatch to use it.

[8sync.git] / 8sync / systems / actors.scm

diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index 8c4258d725267b189d91c86142f7a62f08e6da4f..c33240f309cc181dcf030b905a43b989e4cec186 100644 (file)
--- a/8sync/systems/actors.scm
+++ b/8sync/systems/actors.scm
@@ -47,7 +47,7 @@
             actor-id-hive
             actor-id-string
 
-            mlambda
+            mlambda define-mhandler
             make-action-dispatch
             define-simple-actor
 
@@ -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,15 @@ 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...
+(define-syntax-rule (define-mhandler (name actor message message-arg ...)
+                      body ...)
+  (define name
+    (mlambda (actor message message-arg ...)
+             body ...)))
 
 (define (simple-dispatcher action-map)
   (lambda (actor message)
@@ -356,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
@@ -377,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 (<actor>)