Behaviours are now tagged lists. master
authorTim Vaughan <plugd@thelambdalab.xyz>
Thu, 6 May 2021 12:35:41 +0000 (14:35 +0200)
committerTim Vaughan <plugd@thelambdalab.xyz>
Thu, 6 May 2021 12:35:41 +0000 (14:35 +0200)
sam-macros.scm
sam.scm

index cf4f9ac..bbf8ada 100644 (file)
@@ -10,7 +10,8 @@
   (define-syntax make-beh
     (syntax-rules (: => finally)
       ((make-beh : parent (self) (pat => body ...) ... (finally after ...))
   (define-syntax make-beh
     (syntax-rules (: => finally)
       ((make-beh : parent (self) (pat => body ...) ... (finally after ...))
-       (cons (lambda (self . message)
+       (list 'beh
+             (lambda (self . message)
                (match message
                  (pat body ...)
                  ...
                (match message
                  (pat body ...)
                  ...
diff --git a/sam.scm b/sam.scm
index c40116d..fbe800e 100644 (file)
--- a/sam.scm
+++ b/sam.scm
 ;; (See also macros defined in sam-macros.scm.)
 
 (define (beh-proc beh)
 ;; (See also macros defined in sam-macros.scm.)
 
 (define (beh-proc beh)
-  (car beh))
+  (cadr beh))
 (define (beh-parent beh)
 (define (beh-parent beh)
-  (cdr beh))  
+  (caddr beh))  
 
 (define root-beh
   (make-beh : #f (self)
             (('ping recipient) =>
              (send-message recipient 'pong))))
 
 
 (define root-beh
   (make-beh : #f (self)
             (('ping recipient) =>
              (send-message recipient 'pong))))
 
+(define (beh? x)
+  (and (pair? x)
+       (not (null? x))
+       (eq? (car x) 'beh)))
+
 ;; Actors
 
 (define (make-address host port id)
 ;; Actors
 
 (define (make-address host port id)
                 ('pass
                  (log-trace "Passing to parent behaviour...")
                  (loop (beh-parent beh)))
                 ('pass
                  (log-trace "Passing to parent behaviour...")
                  (loop (beh-parent beh)))
-                ((? procedure? new-beh) (hash-table-set! actor-table id new-beh))
+                ((? beh? new-beh) (hash-table-set! actor-table id new-beh))
                 (else
                  'do-nothing)) ; sleep is now the default
             (o (exn)
                 (else
                  'do-nothing)) ; sleep is now the default
             (o (exn)
 
 (define-beh system-beh
   (self)
 
 (define-beh system-beh
   (self)
+
   (('shutdown) =>
    (log-msg "System actor received shutdown message.")
    (exit 0)
   (('shutdown) =>
    (log-msg "System actor received shutdown message.")
    (exit 0)