dosync+

dosync-plus.clj

(defmacro dosync+ [listeners & body]
  `(let [on-start# (get ~listeners :on-start identity)
         on-retry# (get ~listeners :on-retry identity)
         on-committed# (get ~listeners :on-committed identity)
         retires# (atom 0)
         ctx# (atom {})]
    (dosync
      (if (zero? @retires#)
        (swap! ctx# on-start#)
        (swap! ctx# on-retry#))
      (swap! retires# inc)
      ~@body)
    (on-committed# @ctx#)))

main.clj

(def stm-mon 
  {:on-start (fn [_] 
              (do
                (println "started")
                {:r 0 :t (System/currentTimeMillis)}))
   :on-retry (fn [ctx]
              (do
                (println "retrying")
                (update-in ctx [:r] inc)))
   :on-committed (fn [ctx]
                 (do
                   (println "committed")
                   (println (str "total retry: " (:r ctx)))
                   (println (str "total time: " 
                              (- (System/currentTimeMillis) (:t ctx))))))})

(def m (ref 0))
(def n (ref []))
(defn run! []
 (dosync+ stm-mon 

  (alter m inc)
  (alter n conj @m)))

(dorun (pmap (fn [_] (run!)) (range 1000)))