Skip to content

Instantly share code, notes, and snippets.

@antoniogarrote
Created March 18, 2011 09:43
Show Gist options
  • Save antoniogarrote/875830 to your computer and use it in GitHub Desktop.
Save antoniogarrote/875830 to your computer and use it in GitHub Desktop.
(ns jobim.examples.philosophers
(:use [jobim]))
;;;;;;;;;;;;;
;;; Forks
;;;;;;;;;;;;
(defn do-forks
([forks-list]
(loop [forks-list forks-list]
(let [{:keys [key left right] :as msg} (receive)]
(condp = key
:grab-forks (recur (filter (fn [fork] (and (not= fork left)
(not= fork right)))
forks-list))
:release-forks (recur (concat [left right] forks-list))
:available (do (send! (:from msg) [:are-available (and (some #(= % right) forks-list)
(some #(= % left) forks-list))])
(recur forks-list))
:die (println "Forks put away\r\n"))))))
;; Public forks API
(defn grab-forks
([[left right]]
(send! (resolve-name "forks") {:key :grab-forks :left left :right right})))
(defn release-forks
([[left right]]
(send! (resolve-name "forks") {:key :release-forks :left left :right right})))
(defn forks-available?
([[left right]]
(send! (resolve-name "forks") {:key :available :left left :right right :from (self)})
(let [msg (receive #(= (first %) :are-available))]
(not (nil? (second msg))))))
(defn forks-die
([] (send! (resolve-name "forks") {:key :die})))
(defn register-forks
([num-forks]
(register-name "forks" (spawn (fn [] (do-forks (range num-forks)))))))
;;;;;;;;;;;;;
;;;; Waiter
;;;;;;;;;;;;;
(defn process-wait-list
([clients-forks]
(loop [client-forks clients-forks]
(if (empty? client-forks)
false
(let [[client forks] (first client-forks)]
(if (forks-available? forks)
(do
(send! client :served)
true)
(recur (rest clients-forks))))))))
(defn do-waiter
([wait-list client-count eating-count busy]
(loop [msg (receive)
wait-list wait-list
client-count client-count
eating-count eating-count
busy busy]
(if (and (empty? wait-list)
(= 0 client-count)
(= 0 eating-count))
(do (forks-die)
(send! (resolve-name "dining-room") :all-gone))
(do
(condp = (first msg)
:waiting (let [client-forks (second msg)
wait-list (conj wait-list client-forks)
busy (if (and (not busy) (< eating-count 2))
(process-wait-list wait-list)
busy)]
(recur (receive) wait-list client-count eating-count busy))
:eating (let [client-forks (second msg)]
(recur (receive) (filter #(not= % client-forks) wait-list)
client-count (inc eating-count) false))
:finished (recur (receive) wait-list client-count (dec eating-count) (process-wait-list wait-list))
:leaving (recur (receive) wait-list (dec client-count) eating-count busy)
(do (println (str "STRANGE MESSAGE " msg))
(throw (Exception. "ERROR!")))))))))
;; Public waiter API
(defn waiter-wait
([forks]
(send! (resolve-name "waiter") [:waiting [(self) forks]])))
(defn waiter-eating
([forks]
(send! (resolve-name "waiter") [:eating [(self) forks]])))
(defn waiter-finished
([] (send! (resolve-name "waiter") [:finished])))
(defn waiter-leaving
([] (send! (resolve-name "waiter") [:leaving])))
(defn register-waiter
([clients]
(register-name "waiter" (spawn (fn [] (do-waiter [] (dec clients), 0, false))))))
;;;;;;;;;;;;;;;;;;
;;;; Philospher
;;;;;;;;;;;;;;;;;;
(defn do-philosopher
([name & args]
(loop [forks (first args)
cycle (second args)]
(if (= 0 cycle)
(waiter-leaving)
(do
(println (str name " is thinking (" cycle " remaining).\r\n"))
(Thread/sleep (rand 1000))
(println (str name " is hungry.\r\n"))
(waiter-wait forks)
(let [_served (receive)]
(grab-forks forks)
(waiter-eating forks)
(println (str name " is eating. \r\n")))
(Thread/sleep (rand 1000))
(release-forks forks)
(waiter-finished)
(recur forks (dec cycle)))))))
;; Run it
(defn dining
([] (let [clients 5
life-span 20]
(register-name "dining-room" (self))
(register-forks clients)
(register-waiter clients)
(doseq [[philosopher forks] [["Plato" [4 0]]
["Aristotle" [0 1]]
["Kant" [1 2]]
["Descartes" [2 3]]
["Wittgenstein" [3 4]]]]
(spawn (fn [] (do-philosopher philosopher forks life-span))))
(receive)
(println "Dining room closed.\r\n"))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment