dining_philosophers.clj

(ns dining-philosophers)

(def log-agent (agent 0))

(defn do-log [msg-id message]
  (println message)
  (inc msg-id))

(defn log [& strs]
  (send-off log-agent do-log (apply str strs)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn make-butler [people]
  (let [n (count people)]
    {:forks (ref (vec (repeat n true)))
     :waitcount (atom 0)
     :waitlist (ref (sorted-set-by #(< (first %1) (first %2))))
     :people (into {}  (map-indexed (fn [index person]
                                      [person [index (mod (inc index) n)]])
                                    people))}))

(defn forks-available? [forks ids]
  (every? @forks ids))

(defn- set-forks [forks ids v]
  (dosync (apply alter forks assoc (interleave ids (repeat v)))))

(defn issue-forks [forks ids]
  (set-forks forks ids false))

(defn return-forks [forks ids]
  (set-forks forks ids true))

(defn- deliver-all [promise-vals]
  (doseq [[p v] promise-vals]
    (deliver p v)))

(defn seat-waitlist! [{:keys [forks waitlist people] :as butler}]
  (deliver-all
    (dosync
      (loop [waiting @waitlist
             seated []]
        (if (seq waiting)
          (let [[_ person pager :as wait-entry] (first waiting)
                fork-ids (get people person)]
            (if (forks-available? forks fork-ids)
              (do (issue-forks forks fork-ids)
                  (commute waitlist disj wait-entry)
                  (recur (rest waiting)
                         (conj seated [pager fork-ids])))
              (recur (rest waiting) seated)))
          seated)))))

(defn request-eat! [{:keys [waitlist waitcount] :as butler} person]
  (let [pager (promise)
        n (swap! waitcount inc)]
    (dosync
      (alter waitlist conj [n person pager])
      pager)))

(defn finished-eating! [butler fork-ids]
  (return-forks (:forks butler) fork-ids)
  (seat-waitlist! butler))

(defn philosophate!
  [butler person]
  (log "REQUEST: " person)
  (let [pager (request-eat! butler person)
        my-forks @pager]
    (log "BEGIN: " person)
    (Thread/sleep 500)
    (log "FINISH: " person)
    (finished-eating! butler my-forks)
    (Thread/sleep 250)))

(defn make-philosopher [butler running? person]
  (Thread. (fn []
             (let [eat-count (atom 0)]
               (while @running?
                 (philosophate! butler person)
                 (swap! eat-count inc))
               (log "EAT COUNT: " person " -> " @eat-count)))))

(defn -main []
  (let [running? (atom true)
        people [:socrates :plato :aristotle :locke :descartes :confucius]
        butler (make-butler people)
        philos (map #(make-philosopher butler running? %) people)]
    (doseq [thread philos]
      (.start thread))
    (Thread/sleep 1000)
    (seat-waitlist! butler)
    (Thread/sleep 5000)
    (reset! running? false)
    (doseq [thread philos]
      (.join thread))
    (Thread/sleep 1000)
    (shutdown-agents)))