racktors.rkt

#lang racket
(require racket/async-channel)
(provide spawn ! ? self)

;; kind of actors built from channels and parameters

;; which is not to say that that is a good idea

(define self-param (make-parameter #f))
(define (self) (or (self-param) (error)))



(struct actor (channel)) ;(could just use channel as identity; hiding it because Software Engineering)

;; spawn makes actor/channel
;; parameterizes self-param so (self) evaluates to this actor within f
;; runs f in thread
(define (spawn f . args)
  (define a (actor (make-async-channel)))
  (parameterize ((self-param a))
    (thread (λ () (apply f args))))
  a)

;; send-proc
(define (! recipient message)
  (async-channel-put (actor-channel recipient)
                     message))

;; receive-proc, used by ?-syntax
(define (receive)
  (async-channel-get (actor-channel (self))))


;; overloaded ? because why not
;; ? in (?) or operand position is receive proc
;; ? in operator position, along with operands, is pattern matchy receive syntax
(define-syntax ?
  (syntax-id-rules ()
    ((_ pat pats ...) (match (?) pat pats ...))
    ((_) (receive))
    (_ receive)))


;; bad example:

(define (goat name)
  (define (loop friends)
    (? (`(name-plox ,goat) (! goat `(im ,name))
                      (loop friends))
       (`(befriend ,goat) (! goat `(friends! ,(self)))
                          (loop `(,goat . ,friends)))
       (`(friends! ,goat) (loop `(,goat . ,friends)))
       ('print-friends (for ((g friends)) (! g `(name-plox ,(self))))
                       (cond ((null? friends)
                              (printf "~a has no friends :(~n" name)
                              (loop friends))
                             (else (print-friends friends '()))))))
  (define (print-friends friends names)
    (? (`(name ,goat) (! goat `(im ,name))
                      (print-friends friends names))
       (`(befriend ,goat) (! goat)
                          (print-friends `(,goat . ,friends) names))
       ('print-friends (print-friends friends names))
       (`(im ,a-name)
        (let ((names `(,a-name . ,names)))
          (cond ((= (length names) (length friends))
                 (if (= 1 (length names))
                     (printf "~a's friend is ~a~n" name (car names))
                     (printf "~a's friends are ~a~n"
                             name
                             (string-join names ", " #:before-last " and ")))
                 (loop friends))
                (else (print-friends friends names)))))))
  (loop '()))
          
(define billy (spawn goat "Billy"))
(define benny (spawn goat "Benny"))
(define bob (spawn goat "Bob"))

(! billy `(befriend ,bob))
(! billy `(befriend ,benny))

(sleep 1)
(! billy 'print-friends)
(sleep 1)
(! benny 'print-friends)
(sleep 1)
(! bob 'print-friends)