Permalink
Browse files

Merge branch 'master' into optimize-variadic

  • Loading branch information...
2 parents 0850c3a + c497406 commit 5faa26bb7c28994236e1165ca9eaa017549716cb David Nolen committed May 1, 2012
Showing with 132 additions and 4 deletions.
  1. +132 −4 src/cljs/cljs/core.cljs
View
136 src/cljs/cljs/core.cljs
@@ -195,6 +195,9 @@
(defprotocol IReduce
(-reduce [coll f] [coll f start]))
+(defprotocol IKVReduce
+ (-kv-reduce [coll f init]))
+
(defprotocol IEquiv
(-equiv [o other]))
@@ -886,6 +889,16 @@ reduces them without incurring seq initialization"
([f val coll]
(-reduce coll f val)))
+(defn reduce-kv
+ "Reduces an associative collection. f should be a function of 3
+ arguments. Returns the result of applying f to init, the first key
+ and the first value in coll, then applying f to that result and the
+ 2nd key and value, etc. If coll contains no entries, returns init
+ and f is not called. Note that reduce-kv is supported on vectors,
+ where the keys will be the ordinals."
+ ([f init coll]
+ (-kv-reduce coll f init)))
+
; simple reduce based on seqs, used as default
(defn- seq-reduce
([f coll]
@@ -906,6 +919,20 @@ reduces them without incurring seq initialization"
([coll f start]
(seq-reduce f start coll))))
+(deftype Reduced [val]
+ IDeref
+ (-deref [o] val))
+
+(defn reduced?
+ "Returns true if x is the result of a call to reduced"
+ [r]
+ (instance? Reduced r))
+
+(defn reduced
+ "Wraps x in a way such that a reduce will terminate with the value x"
+ [x]
+ (Reduced. x))
+
;;; Math - variadic forms will not work until the following implemented:
;;; first, next, reduce
@@ -2393,7 +2420,7 @@ reduces them without incurring seq initialization"
(pv-aset ret subidx nil)
ret))))
-(declare tv-editable-root tv-editable-tail TransientVector)
+(declare tv-editable-root tv-editable-tail TransientVector deref)
(deftype PersistentVector [meta cnt shift root tail ^:mutable __hash]
Object
@@ -2502,6 +2529,27 @@ reduces them without incurring seq initialization"
(-reduce [v f start]
(ci-reduce v f start))
+ IKVReduce
+ (-kv-reduce [v f init]
+ (let [step-init (array 0 init)] ; [step 0 init init]
+ (loop [i 0]
+ (if (< i cnt)
+ (let [arr (array-for v i)
+ len (.-length arr)]
+ (let [init (loop [j 0 init (aget step-init 1)]
+ (if (< j len)
+ (let [init (f init (+ j i) (aget arr j))]
+ (if (reduced? init)
+ init
+ (recur (inc j) init)))
+ (do (aset step-init 0 len)
+ (aset step-init 1 init)
+ init)))]
+ (if (reduced? init)
+ @init
+ (recur (+ i (aget step-init 0))))))
+ (aget step-init 1)))))
+
IFn
(-invoke [coll k]
(-lookup coll k))
@@ -3263,6 +3311,16 @@ reduces them without incurring seq initialization"
(recur (+ s 2) (+ d 2))))))))
coll)))
+ IKVReduce
+ (-kv-reduce [coll f init]
+ (let [len (.-length arr)]
+ (loop [i 0 init init]
+ (if (< i len)
+ (let [init (f init (aget arr i) (aget arr (inc i)))]
+ (if (reduced? init)
+ @init
+ (recur (+ i 2) init)))))))
+
IFn
(-invoke [coll k]
(-lookup coll k))
@@ -3405,6 +3463,22 @@ reduces them without incurring seq initialization"
(aset (.-arr editable) j b)
editable)))
+(defn- inode-kv-reduce [arr f init]
+ (let [len (.-length arr)]
+ (loop [i 0 init init]
+ (if (< i len)
+ (let [init (let [k (aget arr i)]
+ (if (coercive-not= k nil)
+ (f init k (aget arr (inc i)))
+ (let [node (aget arr (inc i))]
+ (if (coercive-not= node nil)
+ (.kv-reduce node f init)
+ init))))]
+ (if (reduced? init)
+ @init
+ (recur (+ i 2) init)))
+ init))))
+
(declare ArrayNode)
(deftype BitmapIndexedNode [edit ^:mutable bitmap ^:mutable arr]
@@ -3598,7 +3672,10 @@ reduces them without incurring seq initialization"
(= key key-or-nil)
(do (aset removed-leaf? 0 true)
(.edit-and-remove-pair inode edit bit idx))
- :else inode))))))
+ :else inode)))))
+
+ (kv-reduce [inode f init]
+ (inode-kv-reduce arr f init)))
(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. nil 0 (make-array 0)))
@@ -3697,7 +3774,19 @@ reduces them without incurring seq initialization"
editable))
:else
- (edit-and-set inode edit idx n)))))))
+ (edit-and-set inode edit idx n))))))
+
+ (kv-reduce [inode f init]
+ (let [len (.-length arr)] ; actually 32
+ (loop [i 0 init init]
+ (if (< i len)
+ (let [node (aget arr i)]
+ (if (coercive-not= node nil)
+ (let [init (.kv-reduce node f init)]
+ (if (reduced? init)
+ @init
+ (recur (inc i) init)))))
+ init)))))
(defn- hash-collision-node-find-index [arr cnt key]
(let [lim (* 2 cnt)]
@@ -3801,7 +3890,10 @@ reduces them without incurring seq initialization"
(aset earr (dec (* 2 cnt)) nil)
(aset earr (- (* 2 cnt) 2) nil)
(set! (.-cnt editable) (dec (.-cnt editable)))
- editable)))))))
+ editable))))))
+
+ (kv-reduce [inode f init]
+ (inode-kv-reduce arr f init)))
(defn- create-node
([shift key1 val1 key2hash key2 val2]
@@ -4016,6 +4108,14 @@ reduces them without incurring seq initialization"
coll
(PersistentHashMap. meta (dec cnt) new-root has-nil? nil-val nil)))))
+ IKVReduce
+ (-kv-reduce [coll f init]
+ (let [init (if has-nil? (f init nil nil-val) init)]
+ (cond
+ (reduced? init) @init
+ (coercive-not= nil root) (.kv-reduce root f init)
+ :else init)))
+
IFn
(-invoke [coll k]
(-lookup coll k))
@@ -4281,6 +4381,22 @@ reduces them without incurring seq initialization"
:else
(throw (js/Error. "red-black tree invariant violation"))))
+(defn- tree-map-kv-reduce [node f init]
+ (let [init (f init (.-key node) (.-val node))]
+ (if (reduced? init)
+ @init
+ (let [init (if (coercive-not= (.-left node) nil)
+ (tree-map-kv-reduce (.-left node) f init)
+ init)]
+ (if (reduced? init)
+ @init
+ (let [init (if (coercive-not= (.-right node) nil)
+ (tree-map-kv-reduce (.-right node) f init)
+ init)]
+ (if (reduced? init)
+ @init
+ init)))))))
+
(deftype BlackNode [key val left right ^:mutable __hash]
Object
(toString [this]
@@ -4311,6 +4427,9 @@ reduces them without incurring seq initialization"
(replace [node key val left right]
(BlackNode. key val left right nil))
+ (kv-reduce [node f init]
+ (tree-map-kv-reduce node f init))
+
(toString [this]
(pr-str this))
@@ -4455,6 +4574,9 @@ reduces them without incurring seq initialization"
(replace [node key val left right]
(RedNode. key val left right nil))
+ (kv-reduce [node f init]
+ (tree-map-kv-reduce node f init))
+
(toString [this]
(pr-str this))
@@ -4674,6 +4796,12 @@ reduces them without incurring seq initialization"
ICounted
(-count [coll] cnt)
+ IKVReduce
+ (-kv-reduce [coll f init]
+ (if (coercive-not= tree nil)
+ (tree-map-kv-reduce tree f init)
+ init))
+
IFn
(-invoke [coll k]
(-lookup coll k))

0 comments on commit 5faa26b

Please sign in to comment.