X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=blobdiff_plain;f=sam.scm;h=fbe800e53436138590f3674c7900b7e86e851e39;hp=a8ea67b9e1afb37cb001197f8794865f2bb93d01;hb=HEAD;hpb=fb6698bac8e29c6579a998f59c26192274b9404e diff --git a/sam.scm b/sam.scm index a8ea67b..fbe800e 100644 --- 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)