(import srfi-69 matchable)
+(define trace-enabled #t)
+
;;;
;;; Actor creation
;;;
(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))
;;;
(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
'()
(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
+;;; Testing
;;;
+
+(define factorial
+ (make-actor-with-address 'factorial
+ (lambda (self customer . message)
+ (match message
+ ((n) (send-message self customer n 1) 'sleep)
+ ((0 acc) (send-message customer acc) 'done)
+ ((n acc) (send-message self customer (- n 1) (* acc n)) 'sleep)))))
+
+(define println
+ (make-actor-with-address 'println
+ (lambda (self . message)
+ (apply print message)
+ 'sleep)))
+
+(send-message factorial println 5)
+(send-message factorial println 7)
+(run)