matchable
srfi-18 ; threads
srfi-69 ; hash-table
+ uuid ; ids for actors
+ uri-generic
udp
fifo)
;; Actors
-(define (make-machine host port)
- (cons host port))
-(define (machine-host m) (car m))
-(define (machine-port m) (cdr m))
+(define this-host "localhost")
+(define this-port 1234)
-(define this-machine (make-machine "localhost" 1234))
+(define (make-address host port id)
+ (make-uri #:scheme "actor"
+ #:host host
+ #:port port
+ #:path (list '/ id)))
-(define next-actor-id 1)
+(define next-local-address
+ (let ((mutex (make-mutex "actor address mutex")))
+ (lambda ()
+ (let ((res #f))
+ (mutex-lock! mutex)
+ (set! res (make-address this-host this-port (uuid)))
+ (mutex-unlock! mutex)
+ res))))
-(define (address-id address) (car address))
-(define (address-machine address) (cdr address))
-(define (make-address id machine)
- (cons id machine))
+(define (address-id address) (cadr (uri-path address)))
(define (address-local? address)
- (equal? (address-machine address)
- this-machine))
+ (and (equal? (uri-host address) this-host)
+ (equal? (uri-port address) this-port)))
(define actor-table (make-hash-table))
(define (make-actor beh)
- (let* ((id next-actor-id))
+ (let* ((address (next-local-address))
+ (id (address-id address)))
(hash-table-set! actor-table id beh)
- (make-address id this-machine)))
+ address))
(define (deliver-message address . message)
(let ((id (address-id address)))
(if (null? behaviour)
(print "Warning: discarded message" message " to unknown actor " address)
(match (apply (hash-table-ref actor-table id) (cons address message))
- ('done (hash-table-delete! actor-table actor))
+ ('done (hash-table-delete! actor-table id))
('sleep 'do-nothing)
- (new-beh (hash-table-set! actor-table actor new-beh)))))))
+ (new-beh (hash-table-set! actor-table id new-beh)))))))
;; Scheduler
(apply (if (address-local? address)
send-local-message
send-network-message)
- message))
+ (cons address message)))
(define (send-local-message address . message)
(mutex-lock! local-queue-mutex)
(mutex-unlock! local-queue-mutex)
res))
-(define scheduler-thread
- (make-thread
+(define (start-scheduler)
+ (thread-start!
(lambda ()
- (let loop ((next-addressed-message (next-local-message)))
- (apply deliver-message next-addressed-message)
- (loop (next-local-message))))))
+ (let loop ()
+ (apply deliver-message (next-local-message))
+ (loop)))))
+;; Console
-;; Testing
-
-(thread-start! scheduler-thread)
+(define reader-queue-mutex (make-mutex "reader queue"))
+(define reader-available-mutex (make-mutex "reader available"))
+(mutex-lock! reader-available-mutex #f #f)
+(define reader-queue (make-fifo))
-(define println
+(define console
(make-actor (lambda (self . message)
- (apply print message)
+ (mutex-lock! reader-queue-mutex)
+ (fifo-push reader-queue (car message))
+ (mutex-unlock! reader-available-mutex)
+ (mutex-unlock! reader-queue-mutex)
'sleep)))
-(print println)
-(send-message println "Hello, world!")
+(define (next-reader)
+ (let ((res #f))
+ (mutex-lock! reader-available-mutex #f #f)
+ (mutex-lock! reader-queue-mutex)
+ (set! res (fifo-pop reader-queue))
+ (if (not (fifo-empty? reader-queue))
+ (mutex-unlock! reader-available-mutex))
+ (mutex-unlock! reader-queue-mutex)
+ res))
+
+(define (start-console)
+ (let loop ()
+ (let ((reader (next-reader)))
+ (##sys#thread-block-for-i/o! (current-thread) 0 #t)
+ (thread-yield!)
+ (send-message reader (read-line)))
+ (loop)))
+
+
+;; System interface
+
+(define system
+ (make-actor (lambda (self . message)
+ (match message
+ (('shutdown)
+ (print "## System actor received shutdown message.")
+ (exit 0)
+ 'done)
+ (('println strings ...)
+ (apply print strings)
+ 'sleep)))))
+
+;; Testing
+
+
+(send-message system 'println "Hello, what is your name?")
+(send-message console
+ (make-actor (lambda (self . message)
+ (match message
+ ((name)
+ (send-message system 'println "Hello, " name "!")
+ 'done)))))
+
+(thread-start!
+ (lambda ()
+ (thread-sleep! 10)
+ (send-message system 'shutdown)))
+
+(start-scheduler)
+(start-console)
-(thread-join! scheduler-thread)
+;; (thread-join! scheduler-thread)