X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=actors.scm;h=263acdc7fc1266bb2887f739cfbcd41c39bc4b6a;hb=dfdc81810039a9609f80f3c5f0ba53f8d3e96e7a;hp=9a1b63000b8619391eeeb44b982d47a1110d717d;hpb=db7af542227afb36f567309eaca6a04ff4bb233b;p=actors.git

diff --git a/actors.scm b/actors.scm
index 9a1b630..263acdc 100644
--- a/actors.scm
+++ b/actors.scm
@@ -1,5 +1,7 @@
 (import srfi-69 matchable)
 
+(define trace-enabled #f)
+
 ;;;
 ;;; Actor creation
 ;;;
@@ -7,6 +9,8 @@
 (define actor-table (make-hash-table))
 
 (define (make-actor-with-address address behaviour)
+  (if trace-enabled
+      (print "Making actor with address " address))
   (hash-table-set! actor-table address behaviour)
   address)
 
@@ -23,14 +27,22 @@
 ;;;
 
 (define (dispatch-message address message)
-  (print "Dispatching message " message " to " address)
-  (let* ((behaviour (hash-table-ref actor-table address))
-         (value (behaviour address message)))
-    (match value
-      ('done (hash-table-delete! actor-table address))
-      ('sleep 'do-nothing)
-      (else
-       hash-table-set! actor-table address value))))
+  (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))))
+          (case value
+            ((sleep) 'do-nothing)
+            ((done)
+             (if trace-enabled
+                        (print "Deleting actor " address))
+             (hash-table-delete! actor-table address))
+            (else
+             (if trace-enabled
+                 (print "Updating behaviour of " address))
+             (hash-table-set! actor-table address value)))))))
 
 ;;;
 ;;; FIFO queue implementation
@@ -94,29 +106,23 @@
       '()
       (fifo-pop message-queue)))
 
-(define (send-message actor message)
-  (print "Queued message " message " to " actor)
+(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? addressed-msg)
-        'done
+        '()
         (let ((address (car addressed-msg))
               (message (cdr addressed-msg)))
-          (dispatch-message address message)
-          (run)))))
-
-;;;
-;;; Testing
-;;;
+          (dispatch-message address message)))))
 
-(define factorial
-  (make-actor
-   (lambda (self message)
-     (match message
-       ((n) (send-message self (list n 1)) 'sleep)
-       ((0 acc) (print acc) 'done)
-       ((n acc) (send-message self (list (- n 1) (* acc n))) 'sleep)))))
+(define (run)
+  (unless (null? (process-next-message))
+    (run)))
 
-;(send-message factorial '(5))
+(define (send-and-run actor . message)
+  (apply send-message (cons actor message))
+  (run))