Santa Claus Problem, in Syndicate/rkt

This commit is contained in:
Tony Garnock-Jones 2018-10-24 11:40:16 +01:00
parent 4ddcdfb6a9
commit 6ba3734d9d
1 changed files with 78 additions and 0 deletions

View File

@ -0,0 +1,78 @@
#lang imperative-syndicate
;; Santa Claus Problem
;; https://www.schoolofhaskell.com/school/advanced-haskell/beautiful-concurrency/4-the-santa-claus-problem
;; https://arxiv.org/pdf/1810.09613.pdf
(require/activate imperative-syndicate/drivers/timer)
(require racket/list)
(require racket/set)
(assertion-struct elf-has-a-problem (id))
(assertion-struct reindeer-has-returned (id))
(assertion-struct problem-resolved (id))
(assertion-struct deliver-toys ())
(define N-ELVES 20)
(define ELF-GROUP-SIZE 3)
(define N-REINDEER 9)
(define (elf)
(define elf-self (gensym 'elf))
(spawn* #:name elf-self
(let work-industriously ()
(printf "~a working.\n" elf-self)
(sleep (/ (random 1000) 1000.0))
(printf "~a has a problem!\n" elf-self)
(react (assert (elf-has-a-problem elf-self))
(stop-when (asserted (problem-resolved elf-self))
(printf "~a's problem is resolved.\n" elf-self)
(work-industriously))))))
(define (reindeer)
(define reindeer-self (gensym 'reindeer))
(spawn* #:name reindeer-self
(let holiday ()
(printf "~a is on holiday.\n" reindeer-self)
(sleep (/ (random 9000) 1000.0))
(printf "~a has returned from holiday and is ready to deliver toys!\n" reindeer-self)
(react (assert (reindeer-has-returned reindeer-self))
(stop-when (asserted (deliver-toys))
(printf "~a delivers toys with the other reindeer.\n" reindeer-self)
(react
(stop-when (retracted (deliver-toys))
(printf "~a has been dismissed by Santa.\n" reindeer-self)
(holiday))))))))
(spawn* #:name 'santa
(define (wait-for-work)
(react
(on-start (printf "Santa is waiting for something to do.\n"))
(define/query-set stuck-elves (elf-has-a-problem $id) id)
(define/query-set returned-reindeer (reindeer-has-returned $id) id)
(stop-when-true (= (set-count (returned-reindeer)) N-REINDEER)
(harness-reindeer))
(stop-when-true (>= (set-count (stuck-elves)) ELF-GROUP-SIZE)
(talk-to-elves (take (set->list (stuck-elves)) ELF-GROUP-SIZE)))))
(define (harness-reindeer)
(react
(on-start (printf "Santa does the delivery run!\n"))
(assert (deliver-toys))
(stop-when (retracted (reindeer-has-returned _))
(wait-for-work))))
(define (talk-to-elves elves)
(match elves
['() (wait-for-work)]
[(cons elf remainder)
(react
(on-start (printf "Santa resolves the problem of ~a.\n" elf))
(assert (problem-resolved elf))
(stop-when (retracted (elf-has-a-problem elf))
(talk-to-elves remainder)))]))
(wait-for-work))
(for [(i N-ELVES)] (elf))
(for [(i N-REINDEER)] (reindeer))