angch.venice.1.12.33.source-code.dining-philosophers.venice Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of venice Show documentation
Show all versions of venice Show documentation
Venice, a sandboxed Lisp implemented in Java.
;;;; __ __ _
;;;; \ \ / /__ _ __ (_) ___ ___
;;;; \ \/ / _ \ '_ \| |/ __/ _ \
;;;; \ / __/ | | | | (_| __/
;;;; \/ \___|_| |_|_|\___\___|
;;;;
;;;;
;;;; Copyright 2017-2024 Venice
;;;;
;;;; Licensed under the Apache License, Version 2.0 (the "License");
;;;; you may not use this file except in compliance with the License.
;;;; You may obtain a copy of the License at
;;;;
;;;; http://www.apache.org/licenses/LICENSE-2.0
;;;;
;;;; Unless required by applicable law or agreed to in writing, software
;;;; distributed under the License is distributed on an "AS IS" BASIS,
;;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;;; See the License for the specific language governing permissions and
;;;; limitations under the License.
(do
(import :java.util.concurrent.Semaphore)
(def n-philosophers 5)
(def max-eating-time 5000)
(def max-thinking-time 3000)
(def retry-time 5)
(def forks (->> (range n-philosophers)
(map (fn [x] (. :Semaphore :new 1)))))
(def log-mutex 0)
(defn log [& xs]
(locking log-mutex (println (apply str xs))))
(defn left-fork [n]
(nth forks (mod (dec n) n-philosophers)))
(defn right-fork [n]
(nth forks n))
(defn aquire-fork [fork]
(. fork :tryAcquire))
(defn release-fork [fork]
(. fork :release))
(defn take-forks [n]
(if (aquire-fork (left-fork n))
(if (aquire-fork (right-fork n))
true
(do (release-fork (left-fork n))
false))
false))
(defn put-down-forks [n]
(release-fork (left-fork n))
(release-fork (right-fork n)))
(defn eat [n]
(log "Philosopher " n " is dining")
(sleep (rand-long max-eating-time))
(put-down-forks n)
(log "Philosopher " n " put down forks"))
(defn think [n]
(log "Philosopher " n " is thinking")
(sleep (rand-long max-thinking-time)))
(defn philosopher [n]
(fn []
(try
(log "Philosopher " n " just sat down")
(while true
(if (take-forks n)
(do (log "Philosopher " n " picked up forks")
(eat n)
(think n))
(sleep retry-time)))
(catch :RuntimeException ex
(log "Philosopher " n " died! " (:message ex))))))
;; launch
(println "Starting (stop with )")
(apply futures-wait (futures-fork n-philosophers #(philosopher %)))
)