Create a gist now

Instantly share code, notes, and snippets.

@NalaGinrut /pong.scm
Last active Oct 29, 2015

What would you like to do?
tiny Actor-model
;;==============Tiny framework of Actor-model=========================
(use-modules (ice-9 control) (ice-9 match) (ice-9 q))
(define *mailbox* (make-hash-table))
(define *task-queue* (make-q))
(define (gen-pid n) (gensym (format #f "actor-~a-" n)))
(define-syntax-rule (! pid msg)
(let ((mq (hashq-ref *mailbox* pid)))
(if mq
(enq! mq msg)
(error '! "send msg: invalid pid" pid))))
(define-syntax-rule (has-task?)
(not (q-empty? *task-queue*)))
(define-syntax-rule (self)
(if (has-task?)
(car (q-front *task-queue*))
(error 'self "No task!")))
(define-syntax-rule (receive body ...)
(let lp()
(match (hashq-ref *mailbox* (self))
((or #f (? q-empty?)) (abort 'sleep) (lp))
;; Very important!!! We must schedule the process after each receive scheduled,
;; or we failed to capture the correct continuation here. Don't blame me if you
;; see ghost when remove it, follow me to keep your safe!!!
(mq ((lambda (_) (match _ body ...)) (deq! mq)) (abort 'sleep)))))
(define-syntax-rule (%schedule)
(when (has-task?) ((cdr (q-front *task-queue*)))))
(define-syntax-rule (active-scheduler)
(% (%schedule) scheduler))
(define (scheduler k s)
(%
(case s
((sleep)
(let ((pid (car (deq! *task-queue*))))
(enq! *task-queue* (cons pid k))
(%schedule)))
((quit)
(hashq-remove! *mailbox* (car (deq! *task-queue*)))
(%schedule))
((clean)
(deq! *task-queue*)
(%schedule))
(else (error scheduler "no!" s)))
scheduler))
(define (spawn proc args)
(let ((pid (gen-pid (procedure-name proc))))
(hashq-set! *mailbox* pid (make-q))
(enq! *task-queue* (cons pid (lambda () (apply proc args) (abort 'quit))))
pid))
;;=================Start ping-pong===================
(define (ping . args)
(match args
((0 pong-pid)
(! pong-pid 'finished)
(format #t "ping finished~%"))
((n pong-pid)
(! pong-pid (list 'ping (self)))
(receive
('pong
(format #t "ping received pong~%")))
(ping (1- n) pong-pid))))
(define (pong)
(receive
('finished
(format #t "pong finished~%"))
(('ping ping-pid)
(format #t "pong received ping~%")
(! ping-pid 'pong)
(pong))))
(define (start n)
(let ((pong-pid (spawn pong '())))
(for-each (lambda (i) (spawn ping (list 3 pong-pid))) (iota n))
(active-scheduler)))
Owner

scheme@(guile-user)> (load "pong.scm")
scheme@(guile-user)> (start 3)
pong received ping
ping received pong
pong received ping
ping received pong
pong received ping
ping received pong
ping finished
pong finished

Thanks this is very interseting.

Owner

@amirouche I'll have a blog post to explain it in detail. Anyway, this snippet could be the scheduler core of Artanis server. ;-)

Owner

Fixed to run (start 10) or any number of pings as you wish!

What is % form? You are correct a blogpost will be nice.

Owner

Updated for optimizing.

  • Bad news: Guile-2.0 can't run more than 2500 actors
  • Good news: Guile-2.1 works for more than 10000 actors smoothly, it's not fast at present, but it just take advantage of 1 core yet. We'll manage to use SMP then.
Owner

@amirouche definitely I'll have a post for it ;-)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment