cells.clj

;   Copyright (c) Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(set! *warn-on-reflection* true)

(defprotocol Sentry
  (make-cell [sentry val]))

(defprotocol Cell
  (cell-sentry [cell])
  (cell-get-transient [cell])
  (cell-set-transient [cell t])
  (cell-render [cell]))

(defprotocol Editable
  (transient-of [value]))

(defprotocol Transient
  (value-of [transient]))

(deftype ThreadCell [thread 
                     #^{:unsynchronized-mutable true} val
                     #^{:unsynchronized-mutable true} trans]
  :as this
  Object
  (equals [o] (identical? this o))
  (hashCode [] (System/identityHashCode this))

  clojure.lang.IMeta
  (meta [] __meta)

  clojure.lang.IDeref
  (deref [] (cell-render this))

  Cell
  (cell-sentry [] thread)
  (cell-get-transient [] 
    (assert (identical? (Thread/currentThread) thread))
    (when (identical? ::none trans)
      (set! trans (transient-of val)))
    trans)
  (cell-set-transient [t] (set! trans t) this)
  (cell-render [] 
    (assert (identical? (Thread/currentThread) thread))
    (when-not (identical? trans ::none)
      (set! val (value-of trans))
      (set! trans ::none))
    val))

(deftype LockCell [#^java.util.concurrent.locks.ReentrantLock lock 
                   #^{:volatile-mutable true} val
                   #^{:unsynchronized-mutable true} trans]
  :as this
  Object
  (equals [o] (identical? this o))
  (hashCode [] (System/identityHashCode this))

  Comparable
  (compareTo [o] 
    (cond (identical? lock (:lock o)) 0
          (< (hash lock) (hash (:lock o))) -1
          (> (hash lock) (hash (:lock o))) 1
          :else (throw (IllegalStateException. (str "Duplicate lock hashes for distinct locks: " this " " o)))))

  clojure.lang.IMeta
  (meta [] __meta)

  clojure.lang.IDeref
  (deref [] 
    (if (.isHeldByCurrentThread lock) 
      (cell-render this)
      val))

  Cell
  (cell-sentry [] lock)
  (cell-get-transient [] 
    (assert (.isHeldByCurrentThread lock))
    (when (identical? ::none trans)
      (set! trans (transient-of val)))
    trans)
  (cell-set-transient [t] (set! trans t) this)
  (cell-render [] 
    (assert (.isHeldByCurrentThread lock))
    (when-not (identical? trans ::none)
      (set! val (value-of trans))
      (set! trans ::none))
    val))

(extend-protocol Sentry
  java.lang.Thread
  (make-cell [thread val] (ThreadCell thread val ::none))

  java.util.concurrent.locks.ReentrantLock
  (make-cell [lock val] (LockCell lock val ::none)))

(defmacro pass [f cell & args]
  `(cell-set-transient ~cell (~f ~(with-meta `(cell-get-transient ~cell) (meta cell)) ~@args)))

(defmacro fetch [f cell & args]
  `(~f ~(with-meta `(cell-get-transient ~cell) (meta cell)) ~@args))

(def #^{:macro true} >> (deref (var pass)))
(def #^{:macro true} << (deref (var fetch)))

(defn cell 
  [val] 
  (make-cell (Thread/currentThread) val))

(defn locked-cell 
  [val & opts] 
  (let [optm (when opts (apply hash-map opts))]
    (make-cell (java.util.concurrent.locks.ReentrantLock. (boolean (:fair optm))) val)))

(def *in-cells* nil)

(defn in-cells-fn [cells f]
  (assert (nil? *in-cells*))
  (let [s (java.util.TreeSet. #^java.util.Collection cells)
        unlock-all #(doseq [cell %]
                      (let [lock #^java.util.concurrent.locks.ReentrantLock (:lock cell)]
                        (when (.isHeldByCurrentThread lock) (.unlock lock))))]
    (binding [*in-cells* true]
      (try
       (doseq [cell s]
         (assert (:lock cell))
         (.lock #^java.util.concurrent.locks.ReentrantLock (:lock cell)))
       (f)
       (finally
        (unlock-all s))))))

(defmacro in-cells [cells & body]
  (case (count cells)
    0 `(do ~@body)
    1 `(let [lock#  #^java.util.concurrent.locks.ReentrantLock (:lock ~(first cells))] 
         (assert (nil? *in-cells*))
         (assert lock#)
         (binding [*in-cells* true] 
           (.lock lock#)
           (try
            ~@body
            (finally (.unlock lock#)))))
    `(in-cells-fn [~@cells] (fn [] ~@body))))

(extend-class String
  Editable
  (transient-of [s] (StringBuilder. s)))

(extend-class StringBuilder
  Transient
  (value-of [sb] (.toString sb)))

(extend-class clojure.lang.IEditableCollection
  Editable
  (transient-of [coll] (.asTransient coll)))

(extend-class clojure.lang.ITransientCollection
  Transient
  (value-of [coll] (.persistent coll)))

;;;;;;;;;;;;;;;;;;; some usage ;;;;;;;;;;;;;;;;;;;;

(def v1
  (let [c (cell [])]
    (dotimes [i 1000000]
      (>> conj! c i))
    @c))

(def v2
  (let [c (locked-cell [])]
    (in-cells [c]
      (dotimes [i 1000000]
        (>> conj! c i))
      @c)))

(def s1
  (let [c (cell "")]
    (dotimes [i 100000]
      (>> .append #^StringBuilder c i))
    @c))

(def s2
  (let [c (locked-cell "")]
    (in-cells [c]
      (dotimes [i 100000]
        (>> .append #^StringBuilder c i))
      @c)))

(def s3
  (let [c (cell "")]
    (dotimes [i 100000]
      (>> .append #^StringBuilder c (<< .length #^StringBuilder c)))
    @c))

(def s4
  (let [c (locked-cell "")]
    (in-cells [c]
      (dotimes [i 100000]
        (>> .append #^StringBuilder c (<< .length #^StringBuilder c)))
      @c)))