From: Tim Vaughan <tgvaughan@gmail.com>
Date: Thu, 5 Sep 2019 14:37:06 +0000 (+0200)
Subject: Actors is now a module.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=f24d784945aa108bc579ce5bd777dc17361bcb6f;p=actors.git

Actors is now a module.
---

diff --git a/actors.scm b/actors.scm
index 263acdc..884920d 100644
--- a/actors.scm
+++ b/actors.scm
@@ -1,128 +1,142 @@
-(import srfi-69 matchable)
+(module actors
+  (make-actor
+   make-actor-with-address
+   send-message
+   run
+   send-and-run
+   trace-enabled)
+
+  (import scheme
+          (chicken base)
+          srfi-69
+          matchable)
+
+  (define trace-enabled #f) ;used for debugging
 
-(define trace-enabled #f)
 
 ;;;
 ;;; Actor creation
 ;;;
 
-(define actor-table (make-hash-table))
+  (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)
+  (define (make-actor-with-address address behaviour)
+    (if trace-enabled
+        (print "Making actor with address " address))
+    (hash-table-set! actor-table address behaviour)
+    address)
 
-(define next-actor-address 1)
+  (define next-actor-address 1)
 
-(define (make-actor behaviour)
-  (make-actor-with-address next-actor-address behaviour)
-  (let ((address next-actor-address))
-    (set! next-actor-address (+ next-actor-address 1))
-    address))
+  (define (make-actor behaviour)
+    (make-actor-with-address next-actor-address behaviour)
+    (let ((address next-actor-address))
+      (set! next-actor-address (+ next-actor-address 1))
+      address))
 
+  
 ;;;
 ;;; Message dispatch
 ;;;
 
-(define (dispatch-message 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))))
-          (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)))))))
+  (define (dispatch-message 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))))
+            (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
 ;;;
 
-(define (make-fifo)
-  (define (cell val prev next)
-    (list val prev next))
-  (define cell-val car)
-  (define cell-prev cadr)
-  (define cell-next caddr)
-  (define (set-cell-prev! cell prev-cell)
-    (set-car! (cdr cell) prev-cell))
-  (define (set-cell-next! cell next-cell)
-    (set-car! (cddr cell) next-cell))
-
-  (let ((head '())
-        (tail '()))
-    (lambda (cmd . args)
-      (case cmd
-        ((empty?) (null? head))
-        ((push) (if (not (= (length args) 1))
-                    (error "Wrong number of arguments to push.")
-                    (if (not (null? head))
-                        (let ((old-head head))
-                          (set! head (cell (car args) '() old-head))
-                          (set-cell-prev! old-head head))
-                        (begin
-                          ;; Initialize list
-                          (set! head (cell (car args) '() '()))
-                          (set! tail head)))))
-        ((pop) (if (not (= (length args) 0))
-                   (error "Wrong number of arguments to pop.")
-                   (if (null? head)
-                       (error "FIFO empty.")
-                       (let ((old-tail tail))
-                         (set! tail (cell-prev old-tail))
-                         (if (null? tail)
-                             (set! head '())
-                             (set-cell-next! tail '()))
-                         (cell-val old-tail)))))))))
-
-(define (fifo-push fifo x)
-  (fifo 'push x))
-
-(define (fifo-pop fifo)
-  (fifo 'pop))
-
-(define (fifo-empty? fifo)
-  (fifo 'empty?))
+  (define (make-fifo)
+    (define (cell val prev next)
+      (list val prev next))
+    (define cell-val car)
+    (define cell-prev cadr)
+    (define cell-next caddr)
+    (define (set-cell-prev! cell prev-cell)
+      (set-car! (cdr cell) prev-cell))
+    (define (set-cell-next! cell next-cell)
+      (set-car! (cddr cell) next-cell))
+
+    (let ((head '())
+          (tail '()))
+      (lambda (cmd . args)
+        (case cmd
+          ((empty?) (null? head))
+          ((push) (if (not (= (length args) 1))
+                      (error "Wrong number of arguments to push.")
+                      (if (not (null? head))
+                          (let ((old-head head))
+                            (set! head (cell (car args) '() old-head))
+                            (set-cell-prev! old-head head))
+                          (begin
+                            ;; Initialize list
+                            (set! head (cell (car args) '() '()))
+                            (set! tail head)))))
+          ((pop) (if (not (= (length args) 0))
+                     (error "Wrong number of arguments to pop.")
+                     (if (null? head)
+                         (error "FIFO empty.")
+                         (let ((old-tail tail))
+                           (set! tail (cell-prev old-tail))
+                           (if (null? tail)
+                               (set! head '())
+                               (set-cell-next! tail '()))
+                           (cell-val old-tail)))))))))
+
+  (define (fifo-push fifo x)
+    (fifo 'push x))
+
+  (define (fifo-pop fifo)
+    (fifo 'pop))
+
+  (define (fifo-empty? fifo)
+    (fifo 'empty?))
 
 
 ;;;
 ;;; Message queue
 ;;;
 
-(define message-queue (make-fifo))
-
-(define (next-addressed-msg)
-  (if (fifo-empty? message-queue)
-      '()
-      (fifo-pop message-queue)))
+  (define message-queue (make-fifo))
 
-(define (send-message actor . message)
-  (if trace-enabled
-      (print "Queued message " message " to " actor))
-  (fifo-push message-queue (cons actor message)))
-
-(define (process-next-message)
-  (let ((addressed-msg (next-addressed-msg)))
-    (if (null? addressed-msg)
+  (define (next-addressed-msg)
+    (if (fifo-empty? message-queue)
         '()
-        (let ((address (car addressed-msg))
-              (message (cdr addressed-msg)))
-          (dispatch-message address message)))))
-
-(define (run)
-  (unless (null? (process-next-message))
+        (fifo-pop message-queue)))
+
+  (define (send-message actor . message)
+    (if trace-enabled
+        (print "Queued message " message " to " actor))
+    (fifo-push message-queue (cons actor message)))
+
+  (define (process-next-message)
+    (let ((addressed-msg (next-addressed-msg)))
+      (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)))
-
-(define (send-and-run actor . message)
-  (apply send-message (cons actor message))
-  (run))
diff --git a/testing_counter.scm b/testing_counter.scm
index 55a0812..0b25876 100644
--- a/testing_counter.scm
+++ b/testing_counter.scm
@@ -1,4 +1,4 @@
-(load "actors.scm")
+(import actors)
 
 (define trace-enabled #t)
 
diff --git a/testing_factorial1.scm b/testing_factorial1.scm
index 6600661..188dc32 100644
--- a/testing_factorial1.scm
+++ b/testing_factorial1.scm
@@ -1,4 +1,4 @@
-(load "actors.scm")
+(import actors)
 
 (define trace-enabled #t)
 
@@ -17,5 +17,5 @@
      'sleep)))
 
 (send-message factorial println 5)
-(send-message factorial println 7)
+;;(send-message factorial println 7)
 (run)
diff --git a/testing_factorial2.scm b/testing_factorial2.scm
index 363b61b..bba678e 100644
--- a/testing_factorial2.scm
+++ b/testing_factorial2.scm
@@ -1,4 +1,4 @@
-(load "actors.scm")
+(import actors)
 
 (define trace-enabled #t)
 
diff --git a/testing_factorial3.scm b/testing_factorial3.scm
index 1cb9dd9..29d3f85 100644
--- a/testing_factorial3.scm
+++ b/testing_factorial3.scm
@@ -1,4 +1,4 @@
-(load "actors.scm")
+(import actors)
 
 (define trace-enabled #t)