Create a gist now

Instantly share code, notes, and snippets.

@NalaGinrut /pong.scm
Last active Jul 12, 2017

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
(let ((pid (car (deq! *task-queue*))))
(enq! *task-queue* (cons pid k))
(hashq-remove! *mailbox* (car (deq! *task-queue*)))
(deq! *task-queue*)
(else (error scheduler "no!" s)))
(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))))
;;=================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)))
(format #t "ping received pong~%")))
(ping (1- n) pong-pid))))
(define (pong)
(format #t "pong finished~%"))
(('ping ping-pid)
(format #t "pong received ping~%")
(! ping-pid 'pong)
(define (start n)
(let ((pong-pid (spawn pong '())))
(for-each (lambda (i) (spawn ping (list 3 pong-pid))) (iota n))

NalaGinrut commented Aug 11, 2015

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.


NalaGinrut commented Aug 12, 2015

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


NalaGinrut commented Aug 24, 2015

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

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


NalaGinrut commented Aug 24, 2015

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.

NalaGinrut commented Aug 24, 2015

@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