X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=actors.scm;h=4ae01ed615767c699d29f3a05f2292d0e421d51f;hb=758646ce472f2610b3100779fcf2b8ad15481a4e;hp=b8e52a80ae481f5fcd1043ef837e94ba2ddd5171;hpb=02d417662aac86f8fba65a69bef8b6cc5923becd;p=actors.git

diff --git a/actors.scm b/actors.scm
index b8e52a8..4ae01ed 100644
--- a/actors.scm
+++ b/actors.scm
@@ -1,5 +1,7 @@
 (import srfi-69 matchable)
 
+(define trace-enabled #t)
+
 ;;;
 ;;; Actor creation
 ;;;
@@ -13,7 +15,7 @@
 (define next-actor-address 1)
 
 (define (make-actor behaviour)
-  (make-actor-with-id next-actor-address behaviour)
+  (make-actor-with-address next-actor-address behaviour)
   (let ((address next-actor-address))
     (set! next-actor-address (+ next-actor-address 1))
     address))
@@ -23,9 +25,17 @@
 ;;;
 
 (define (dispatch-message address message)
-  (let ((behaviour (hash-table-ref actor-table address)))
-    (unless (null? behaviour)
-      ((hash-table-ref actor-table address)))) message)
+  (if trace-enabled
+      (print "Dispatching message " message " to " address))
+  (let ((behaviour (hash-table-ref/default actor-table address '())))
+    (if (null? behaviour)
+        (print "Warning: discarded message " message " to unknown actor " address)
+        (let ((value (apply behaviour (cons address message))))
+          (match value
+            ('done (hash-table-delete! actor-table address))
+            ('sleep 'do-nothing)
+            (else
+             hash-table-set! actor-table address value))))))
 
 ;;;
 ;;; FIFO queue implementation
@@ -89,17 +99,24 @@
       '()
       (fifo-pop message-queue)))
 
-(define (send-message actor message)
+(define (send-message actor . message)
+  (if trace-enabled
+      (print "Queued message " message " to " actor))
   (fifo-push message-queue (cons actor message)))
 
-(define (run)
+(define (process-next-message)
   (let ((addressed-msg (next-addressed-msg)))
-    (if (null? msg)
-        'done
-        (begin
-          (apply dispatch-message addressed-msg)
-          (run)))))
+    (if (null? addressed-msg)
+        '()
+        (let ((address (car addressed-msg))
+              (message (cdr addressed-msg)))
+          (dispatch-message address message)))))
+
+(define (run)
+  (unless (null? (process-next-message))
+    (run)))
+
+(define (send-and-run actor . message)
+  (apply send-message (cons actor message))
+  (run))
 
-;;;
-;;; Send
-;;;