I'm very new to Clojure and I've been struggling to implement some concurrent code. I've found this code on the web. There is a warning that it is not a proper way to do concurrency in Clojure, but I want to understand this code anyway.
(def *readers* (map #(agent %) '("one" "two" "three")))
(def *writers* (map #(agent %) '("four" "five")))
(def *mutex* (agent :unlocked))
(def *value* 0)
; mutex implementation
(defn lock [state who success-fn fail-fn]
(send who (if (= state :locked) fail-fn success-fn))
:locked)
(defn unlock [mutex]
:unlocked)
; Must be invoked with send-off since this handler blocks
(defn rand-sleep [state next-fn]
(Thread/sleep (rand-int 5))
(send *agent* next-fn)
state)
; Reader functions
(declare try-read)
(defn reader-got-lock [name]
(println (format "Thread %s says that the value is %d." name *value*))
(send *mutex* unlock)
(send-off *agent* rand-sleep try-read)
name)
(defn reader-did-not-get-lock [name]
(println (format "Thread %s tried to read the value, but could not." name))
(send-off *agent* rand-sleep try-read)
name)
(defn try-read [name]
(send *mutex* lock *agent* reader-got-lock reader-did-not-get-lock)
name)
; Writer functions
(declare try-write)
(defn writer-got-lock [name]
(println (format "Thread %s is taking the lock." name))
(def *value* (rand-int 10))
(println (format "Thread %s is changing the value to %d." name *value*))
(send *mutex* unlock)
(println (format "Thread %s is relasing the lock." name))
(send-off *agent* rand-sleep try-write)
name)
(defn writer-did-not-get-lock [name]
(println (format "Thread %s tried to write the value, but could not." name))
(send-off *agent* rand-sleep try-write)
name)
(defn try-write [name]
(send *mutex* lock *agent* writer-got-lock writer-did-not-get-lock)
name)
(dorun (map #(send % try-write) *writers*))
(dorun (map #(send % try-read) *readers*))
Specifically I'm stuck at this line:
(defn try-write [name]
(send *mutex* lock *agent* writer-got-lock writer-did-not-get-lock)
name)
It should lock the mutex and call either writer-got-lock or writer-did-not-get-lock depending on the mutexes state. But where is *agent* declared, or is it a shortcut to access the current agent? Then how a state is passed to the lock, is it *agent* in case of the above call or *agent* is who?
*agent* is a short-cut for the current agent and is implicitly provided by clojure. *agent* is passed as who. The final call roughly looks like this:
(lock #*mutex* *agent* writer-got-lock writer-did-not-get-lock)
Related
I am using [org.clojure/clojure "1.10.1"],[org.clojure/core.async "1.2.603"] and the latest Amazon Corretto 11 JVM if there was anything to do with them.
The following code is a simplified version of the code used in production and it does cause memory leak. I have no idea why that happened but suspect it might due to sub/unsub of channels. Can anyone help point out where my code may go wrong or how I can fix the memory leak?
(ns test-gc.core
(:require [clojure.core.async :as a :refer [chan put! close! <! go >! go-loop timeout]])
(:import [java.util UUID]))
(def global-msg-ch (chan (a/sliding-buffer 200)))
(def global-msg-pub (a/pub global-msg-ch :id))
(defn io-promise []
(let [id (UUID/randomUUID)
ch (chan)]
(a/sub global-msg-pub id ch)
[id (go
(let [x (<! ch)]
(a/unsub global-msg-pub id ch)
(:data x)))]))
(defn -main []
(go-loop []
(<! (timeout 1))
(let [[pid pch] (io-promise)
cmd {:id pid
:data (rand-int 1E5)}]
(>! global-msg-ch cmd)
(println (<! pch)))
(recur))
(while true
(Thread/yield)))
A quick heap dump gives the following statistics for example:
Class by number of instances
java.util.LinkedList 5,157,128 (14.4%)
java.util.concurrent.atomic.AtomicReference 3,698,382 (10.3%)
clojure.lang.Atom 3,094,279 (8.6%)
...
Class by size of instances
java.lang.Object[] 210,061,752 B (13.8%)
java.util.LinkedList 206,285,120 B (13.6%)
clojure.lang.Atom 148,525,392 B (9.8%)
clojure.core.async.impl.channels.ManyToManyChannel 132,022,336 B (8.7%)
...
I finally figured out why. By looking at the source code, we get the following segment:
(defn pub
"Creates and returns a pub(lication) of the supplied channel, ..."
...
(let [mults (atom {}) ;;topic->mult
ensure-mult (fn [topic]
(or (get #mults topic)
(get (swap! mults
#(if (% topic) % (assoc % topic (mult (chan (buf-fn topic))))))
topic)))
p (reify
Mux
(muxch* [_] ch)
Pub
(sub* [p topic ch close?]
(let [m (ensure-mult topic)]
(tap m ch close?)))
(unsub* [p topic ch]
(when-let [m (get #mults topic)]
(untap m ch)))
(unsub-all* [_] (reset! mults {}))
(unsub-all* [_ topic] (swap! mults dissoc topic)))]
...
p)))
We can see mults stores all topic hence shall increase monotonically if we do not clear it. We may add something like (a/unsub-all* global-msg-pub pid) to fix that.
consider the following core-async code. It prints the string "tick" every 2 seconds:
(go-loop []
(<! (timeout 2000))
(prn "tick")
(recur))
I'm looking for a possibility to start and stop the interval from outside via functions.
The only thing that came to my mind was this:
(def running (atom false))
(defn start []
(reset! running true)
(go (loop []
(<! (timeout 2000))
(prn "tick")
(when #running (recur)))))
(defn stop []
(reset! running false))
Is this the way to go? Or would you do something else?
Here's what I would do:
(require '[clojure.core.async :as a])
(defn interval [f msecs]
(let [timing (a/chan)
kickoff
#(a/go
(a/<! (a/timeout msecs))
(a/>! timing true))]
(a/go-loop []
(when (a/<! timing)
(a/go (f))
(kickoff)
(recur)))
(kickoff)
#(a/close! timing)))
Example:
(let [i (interval #(prn "tick") 2000)]
(Thread/sleep 7000)
(i))
;; "tick"
;; "tick"
;; "tick"
;;=> nil
This way, all your state is local and is handled via channels and go blocks, rather than using a global atom. Since the work done in each iteration of the loop is more or less constant, your actual interval time should be fairly close to the number of msecs you pass in.
Or if you want to guarantee that the different calls to f are executed in chronological order, you could do something like this instead:
(require '[clojure.core.async :as a])
(defn interval [f msecs]
(let [action (a/chan (a/dropping-buffer 1))
timing (a/chan)
kickoff
#(a/go
(a/<! (a/timeout msecs))
(a/>! timing true))]
(a/go-loop []
(when (a/<! action)
(f)
(recur)))
(a/go-loop []
(if (a/<! timing)
(do
(a/>! action true)
(kickoff)
(recur))
(a/close! action)))
(kickoff)
#(a/close! timing)))
(The usage of this function is the same as that of my earlier interval function.)
Here all the calls to f are in the same loop. I'm using a dropping buffer, so if a call to f takes longer than msecs, future calls may start getting dropped to keep up.
Here is another way, you could go
(defn start []
(let [ctl (chan 0 )]
(go-loop []
(alt!
(timeout 2000) (do
(prn "tick")
(recur))
ctl (prn "Exit ")))
ctl))
(let [w (start) ]
(Thread/sleep 7000)
(>!! w "stop"))
;;=> "tick"
"tick"
"Exit"
You don't need to define state in namespace. Start function is returning chan to do stop in future.
I'm implementing Sleeping barber using core.async. My current code is:
(def workingtime 10000)
(defn barber [in waiting-room]
(go-loop [served-customers 0]
(let [[v] (alts! [waiting-room in])]
(if (= v :close)
served-customers
(do (Thread/sleep 20)
(recur (inc served-customers)))))))
(defn customers [in waiting-room]
(go-loop [customers-overall 0]
(let [customer-arrival-interval (timeout (+ 10 (rand-int 20)))
[v] (alts! [in customer-arrival-interval])]
(if (= v :close)
customers-overall
(do (>! waiting-room :customer)
(recur (inc customers-overall)))))))
(defn -main [& args]
(let [in (chan)
waiting-room (chan (dropping-buffer 3))
barber-ch (barber in waiting-room)
customers-ch (customers in waiting-room)]
(println "opening the shop for 10 seconds...")
(Thread/sleep workingtime)
(>!! in :close)
(>!! in :close)
(println "closing the shop...")
(println (str "Served " (<!! barber-ch) " customers"))
(println (str "Overall " (<!! customers-ch) " customers came"))))
Is it a correct solution? Can it be improved to make it more Clojure-like?
I wanted to use alt! instead of alts! which makes code easier to read:
(defn barber [in]
(go-loop [served-customers 0]
(alt!
waiting-room (do (Thread/sleep 20)
(recur (inc served-customers)))
in served-customers)))
Runtime throws an exception: Can only recur from tail position. Can I still use alt!?
You could solve the alt!/recur problem by rewriting to:
(defn barber [in]
(go-loop [served-customers 0]
(if (= :waiting-room
(a/alt!
waiting-room ([result] :waiting-room) ;; you could also use result if needed
in ([result] :in))) ;; same here
(do (Thread/sleep 20)
(recur (inc served-customers)))
served-customers)))
I have a namespace like this:
(ns foo.core)
(def ^:dynamic *debug-fn*
"A function taking arguments [bar baz]"
nil)
(defn bar-info
[bar _]
(println bar))
(defn baz-info
[_ baz]
(println baz))
(defn do-stuff
[bar baz]
(when *debug-fn* (*debug-fn* bar baz)))
(defn -main
[& {:keys [debug-fn]}]
(binding [*debug-fn* (symbol debug-fn)] ;; THIS WON'T WORK!
(do-stuff 27 42)))
What I would like to do is allow a debug function to be specified from the command line like this: lein run bar-info or lein run baz-info.
I'm not sure how to take the string specified as a command-line argument and turn it into the namespace-qualified function to bind. Do I need a macro to do this?
Use ns-resolve, you will need to specify namespace where your function is defined though.
user=> (defn f [n] (* n n n))
#'user/f
user=> ((ns-resolve *ns* (symbol "f")) 10)
1000
Use alter-var-root:
user=> (doc alter-var-root)
-------------------------
clojure.core/alter-var-root
([v f & args])
Atomically alters the root binding of var v by applying f to its
current value plus any args
nil
user=> (alter-var-root #'*debug-fn* (fn [v] (fn [x] (println x) x)))
#<user$eval171$fn__172$fn__173 user$eval171$fn__172$fn__173#7c93d88e>
user=> (*debug-fn* 1)
1
1
Though I've accepted Guillermo's answer above, I figured that it might also be useful to add the solution I ended up going with:
(def debug-fns
{:bar-info (fn [bar _] (println bar))
:baz-info (fn [_ baz] (println baz))
(def active-debug-fns (atom []))
(defn activate-debug-fn!
[fn-key]
(let [f (debug-fns fn-key)]
(if f
(swap! active-debug-fns conj f)
(warn (str "Debug function " fn-key " not found! Available functions are: "
(join " " (map name (keys debug-fns))))))))
(defn debug-fn-keys
[args]
(if (args "--debug")
(split (or (args "--debug") "") #",")
[]))
(defn do-stuff
[bar baz]
(doseq [f #active-debug-fns]
(f bar baz)))
(defn -main
[& args]
(let [args (apply hash-map args)]
(doseq [f (debug-fn-keys args)]
(activate-debug-fn! (keyword k)))
(do-stuff 27 42)))
So now you can say something like lein run --debug bar-info to get info on bars, or lein run --debug bar,baz to get info on both bars and bazes.
Any suggestions to make this more idiomatic will be happily accepted and edited in. :)
I can launch two threads and they work, but synchronously. What am I missing to get these threads independently launched?
main, thread, and output
(defn -main
[& args]
(do
(let [grid-dim-in [0 5]
mr1-pos [\N 2 4]
mr2-pos [\N 1 5]
mr1-movs "LMLMMRMM"
mr2-movs "RMRMMMLM"]
(reset! grid-dim grid-dim-in)
(reset! mr1-id {:mr1 mr1-pos})
(reset! mr2-id {:mr2 mr2-pos})
(.start (Thread. (rover-thread mr1-id mr1-movs update-work-block)))
(.start (Thread. (rover-thread mr2-id mr2-movs update-work-block))))))
(defn rover-thread [id movs update-ref]
(let [id-key (keys #id)
id-vals (vals #id)]
(doseq [mov movs]
(println "Rover " id-key " is moving ")
(let [new-mov (determine-rover-move (first id-vals) mov)]
(move-rover id new-mov update-ref)
(print "Rover ")
(print (first id-key))
(print " is at ")
(println new-mov)
(Thread/sleep (rand 1000)))))
Rover :mr1 is at [E 2 4]
Rover (:mr1) is moving
Rover :mr1 is at [N 2 5]
Rover (:mr1) is moving
Rover :mr1 is at [N 2 5]
Finished on Thread[main,5,main]
Rover (:mr2) is moving
Rover :mr2 is at [E 1 5]
Rover (:mr2) is moving
Rover :mr2 is at [N 1 6]
Take a close look at these two lines:
(.start (Thread. (rover-thread mr1-id mr1-movs update-work-block)))
(.start (Thread. (rover-thread mr2-id mr2-movs update-work-block))))))
This code evaluates the (rover-thread mr1-id mr1-movs update-work-block) first, and passes the result of that to the constructor of Thread, which is not what you want.
Here's a simple function to illustrate the principle. This doesn't work, because the (f ...) is evaluated before its result it passed to the Thread constructor:
(defn run-thread-thing-wrong []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(.start (Thread. (f 10 "A")))
(.start (Thread. (f 10 "B"))))
nil)
Here's a version that does work. A function is passed to the Thread constructor instead:
(defn run-thread-thing []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(.start (Thread. (fn [] (f 10 "A"))))
(.start (Thread. (fn [] (f 10 "B")))))
nil)
Note: instead of (fn [] ....) you can use the short form #(....) for anonymous functions.
Here's another version that does the same, but with a future instead of manually creating threads:
(defn run-thread-thing []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(future (f 10 "A"))
(future (f 10 "B")))
nil)
Note that in this case, you pass a form to future instead of a function.
This seems like a really good place to use Clojure's agent feature. I am not qualified to fully explain how to use them, but a really good example of their usage can be found here. Starting threads using agents is dead-easy, and I think it is more idiomatic.
The code would look something like,
(def rover1 (agent [mr1-posn mr1-movs mr1-id]))
(def rover2 (agent [mr2-posn mr2-movs mr2-id]))
(defn rover-behave [[posn movs id]]
(send-off *agent* #'rover-behave)
(. Thread (sleep 1000))
(let [new-mov (determine-rover-move posn movs id)
new-posn (posn-after-move posn new-mov)]
;return value updates state of agent
[new-posn movs id]
)
)
(send-off rover1 rover-behave)
(send-off rover2 rover-behave)