1 (import srfi-69 matchable)
7 (define actor-table (make-hash-table))
9 (define (make-actor-with-address address behaviour)
10 (hash-table-set! actor-table address behaviour)
13 (define next-actor-address 1)
15 (define (make-actor behaviour)
16 (make-actor-with-id next-actor-address behaviour)
17 (let ((address next-actor-address))
18 (set! next-actor-address (+ next-actor-address 1))
25 (define (dispatch-message address message)
26 (let ((behaviour (hash-table-ref actor-table address)))
27 (unless (null? behaviour)
28 ((hash-table-ref actor-table address)))) message)
31 ;;; FIFO queue implementation
35 (define (cell val prev next)
38 (define cell-prev cadr)
39 (define cell-next caddr)
40 (define (set-cell-prev! cell prev-cell)
41 (set-car! (cdr cell) prev-cell))
42 (define (set-cell-next! cell next-cell)
43 (set-car! (cddr cell) next-cell))
49 ((empty?) (null? head))
50 ((push) (if (not (= (length args) 1))
51 (error "Wrong number of arguments to push.")
52 (if (not (null? head))
53 (let ((old-head head))
54 (set! head (cell (car args) '() old-head))
55 (set-cell-prev! old-head head))
58 (set! head (cell (car args) '() '()))
60 ((pop) (if (not (= (length args) 0))
61 (error "Wrong number of arguments to pop.")
64 (let ((old-tail tail))
65 (set! tail (cell-prev old-tail))
68 (set-cell-next! tail '()))
69 (cell-val old-tail)))))))))
71 (define (fifo-push fifo x)
74 (define (fifo-pop fifo)
77 (define (fifo-empty? fifo)
85 (define message-queue (make-fifo))
87 (define (next-addressed-msg)
88 (if (fifo-empty? message-queue)
90 (fifo-pop message-queue)))
92 (define (send-message actor message)
93 (fifo-push message-queue (cons actor message)))
96 (let ((addressed-msg (next-addressed-msg)))
100 (apply dispatch-message addressed-msg)