Behaviours are now tagged lists.

[sam.git] / sam.scm

diff --git a/sam.scm b/sam.scm
index a8ea67b..fbe800e 100644 (file)
--- a/sam.scm
+++ b/sam.scm
@@ -51,15 +51,19 @@
 ;; (See also macros defined in sam-macros.scm.)
 
 (define (beh-proc beh)
-  (car beh))
+  (cadr beh))
 (define (beh-parent beh)
-  (cdr beh))  
+  (caddr beh))  
 
 (define root-beh
   (make-beh : #f (self)
             (('ping recipient) =>
-             (send-message recipient 'pong)
-             'sleep)))
+             (send-message recipient 'pong))))
+
+(define (beh? x)
+  (and (pair? x)
+       (not (null? x))
+       (eq? (car x) 'beh)))
 
 ;; Actors
 
@@ -111,13 +115,12 @@
           (condition-case
               (match (apply (beh-proc beh) (cons address message))
                 ('done (hash-table-delete! actor-table id))
-                ('sleep 'do-nothing)
                 ('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
-                 (log-msg "Warning: behaviour of actor " id " returned invalid value.")))
+                 'do-nothing)) ; sleep is now the default
             (o (exn)
              (log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
              (print-error-message o)))
@@ -224,21 +227,20 @@
 
 (define-beh system-beh
   (self)
+
   (('shutdown) =>
    (log-msg "System actor received shutdown message.")
    (exit 0)
    'done)
 
   (('print strings ...) =>
-   (apply print strings)
-   'sleep)
+   (apply print strings))
 
   (('read reader) =>
    (mutex-lock! reader-queue-mutex)
    (fifo-push reader-queue reader)
    (mutex-unlock! reader-available-mutex)
-   (mutex-unlock! reader-queue-mutex)
-   'sleep))
+   (mutex-unlock! reader-queue-mutex)))
 
 (define (boot-sam)
   (start-console)