Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
; 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] [sentry val transient]))
(defprotocol Cell
(cell-sentry [cell])
(cell-get-transient [cell])
(cell-set-transient [cell t])
(cell-render [cell]))
(defprotocol Editable
(transient-of [value sentry]))
(defprotocol Transient
(value-of [transient]))
(defonce #^java.lang.ThreadLocal tl-in-cells (ThreadLocal.))
(deftype ThreadCell [thread
#^{:unsynchronized-mutable true} val
#^{:unsynchronized-mutable true} trans
__meta]
Object
(equals [this o] (identical? this o))
(hashCode [this] (System/identityHashCode this))
clojure.lang.IMeta
(meta [_] __meta)
clojure.lang.IDeref
(deref [this] (cell-render this))
Cell
(cell-sentry [_] thread)
(cell-get-transient [_]
(assert (identical? (Thread/currentThread) thread))
(when (identical? ::none trans)
(set! trans (transient-of val thread)))
trans)
(cell-set-transient [this 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
__meta]
Object
(equals [this o] (identical? this o))
(hashCode [this] (System/identityHashCode this))
Comparable
(compareTo [this 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 [this]
(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 lock)))
trans)
(cell-set-transient [this 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))
([thread val transient] (ThreadCell. thread val transient)))
java.util.concurrent.locks.ReentrantLock
(make-cell
([lock val] (LockCell. lock val ::none))
([lock val transient] (LockCell. lock val transient))))
(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))
([val transient]
(make-cell (Thread/currentThread) val transient)))
(defn locked-cell
([val]
(make-cell (java.util.concurrent.locks.ReentrantLock.) val))
([val transient]
(make-cell (java.util.concurrent.locks.ReentrantLock.) val transient)))
(defn in-cells-fn [cells f]
(assert (nil? (.get tl-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))))]
(try
(.set tl-in-cells true)
(doseq [cell s]
(assert (:lock cell))
(.lock #^java.util.concurrent.locks.ReentrantLock (:lock cell)))
(f)
(finally
(.set tl-in-cells nil)
(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 (identical? nil (.get tl-in-cells)))
;(assert lock#)
(do
(.set tl-in-cells true)
(.lock lock#)
(try
~@body
(finally
(.set tl-in-cells nil)
(.unlock lock#)))))
`(in-cells-fn [~@cells] (fn [] ~@body))))
(extend-type String
Editable
(transient-of [s _] (StringBuilder. s)))
(extend-type StringBuilder
Transient
(value-of [sb] (.toString sb)))
(extend-type clojure.lang.IEditableCollection
Editable
(transient-of [coll _] (.asTransient coll)))
(extend-type clojure.lang.ITransientCollection
Transient
(value-of [coll] (.persistent coll)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; seqiters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defprotocol Iter
(has-item [iter])
(item [iter])
(move! [iter]))
(definterface IterSeqImpl
(mkseq []))
(deftype IterSeq [#^{:unsynchronized-mutable true} iter-cell
#^{:unsynchronized-mutable true :tag clojure.lang.ISeq} seq-val]
Iter
(has-item [this] (.seq this))
(item [this] (.first this))
(move! [this] (.more this))
user.IterSeqImpl
(mkseq [this]
(locking this
(when iter-cell
(set! seq-val
(when (<< has-item iter-cell)
(clojure.lang.Cons. (<< item iter-cell) (IterSeq. (>> move! iter-cell) nil))))
(set! iter-cell nil))
seq-val))
clojure.lang.Seqable
(seq [this] (.mkseq this))
clojure.lang.ISeq
(first [this] (.mkseq this) (if (nil? seq-val) nil (.first seq-val)))
(more [this] (.mkseq this) (if (nil? seq-val) () (.more seq-val)))
user.Editable
(transient-of [_ sentry] (transient-of (if iter-cell @iter-cell seq-val) sentry)))
(defn iter-seq [iter]
(IterSeq. (cell nil iter) nil))
;todo - factor out the commonality below into a macro
(defn mapx
"Returns a lazy sequence consisting of the result of applying f to the
set of first items of each coll, followed by applying f to the set
of second items in each coll, until any one of the colls is
exhausted. Any remaining items in other colls are ignored. Function
f should accept number-of-colls arguments."
([f coll]
(letfn [(iter [f seq-cell]
(reify
Iter
(has-item [_] (<< has-item seq-cell))
(item [_] (f (<< item seq-cell)))
(move! [this] (>> move! seq-cell) this)
Transient
(value-of [_]
(reify Editable
(transient-of [_ sentry]
(iter f (make-cell sentry (sequence @seq-cell))))))))]
(iter-seq (iter f (cell (sequence coll)))))))
(defn filterx
"Returns a lazy sequence of the items in coll for which
(pred item) returns true. pred must be free of side-effects."
[pred coll]
(letfn [(iter [pred seq-cell]
(reify
Iter
(has-item [_]
(loop [cc seq-cell]
(when (and (<< has-item cc) (not (pred (<< item cc))))
(recur (>> move! cc))))
(<< has-item seq-cell))
(item [_] (<< item seq-cell))
(move! [this] (>> move! seq-cell) this)
Transient
(value-of [_]
(reify Editable
(transient-of [_ sentry]
(iter pred (make-cell sentry (sequence @seq-cell))))))))]
(iter-seq (iter pred (cell (sequence coll))))))
(defn takex
"Returns a lazy sequence of the first n items in coll, or all items if
there are fewer than n."
[n coll]
(letfn [(iter [ai n seq-cell]
(reify
Iter
(has-item [_] (and (<< has-item seq-cell) (< @ai n)))
(item [_] (<< item seq-cell))
(move! [this] (swap! ai inc) (>> move! seq-cell) this)
Transient
(value-of [_]
(reify Editable
(transient-of [_ sentry]
(iter (atom @ai) n (make-cell sentry (sequence @seq-cell))))))))]
(iter-seq (iter (atom 0) n (cell (sequence coll))))))
(extend-type clojure.lang.LazySeq
Editable
(transient-of [ls _] ls)
Iter
(has-item [ls] (.seq ls))
(item [ls] (.first ls))
(move! [ls] (.more ls)))
(extend-type clojure.lang.ASeq
Editable
(transient-of [ls _] ls)
Iter
(has-item [ls] (.seq ls))
(item [ls] (.first ls))
(move! [ls] (.more ls)))
(extend-type clojure.lang.PersistentList$EmptyList
Editable
(transient-of [ls _] ls)
Iter
(has-item [ls] nil)
(item [ls] nil)
(move! [ls] ls))
(defn reducex [f init coll]
(let [cc (cell (sequence coll))]
(loop [ret init cc cc]
(if (<< has-item cc)
(recur (f ret (<< item cc))
(>> move! cc))
ret))))
(deftype Range [comp #^{:unsynchronized-mutable true} start end step]
Iter
(has-item [_] (comp start end))
(item [_] start)
(move! [this] (set! start (+ start step)) this)
Transient
(value-of [_]
(reify Editable
(transient-of [_ _] (Range. comp start end step)))))
(defn rangex [start end step]
(let [comp (if (pos? step) < >)]
(iter-seq (Range. comp start end step))))
(reducex + 0 (mapx inc (filterx even? (rangex 0 1000000 1))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment