From 6ba3734d9de1329dd93079ae107decaf9d33ffee Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Wed, 24 Oct 2018 11:40:16 +0100
Subject: [PATCH] Santa Claus Problem, in Syndicate/rkt

---
 syndicate/examples/santa.rkt | 78 ++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 syndicate/examples/santa.rkt

diff --git a/syndicate/examples/santa.rkt b/syndicate/examples/santa.rkt
new file mode 100644
index 0000000..9a52ff3
--- /dev/null
+++ b/syndicate/examples/santa.rkt
@@ -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))