|
rlm@10
|
1 ; Copyright (c) Rich Hickey. All rights reserved.
|
|
rlm@10
|
2 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
4 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
5 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
6 ; the terms of this license.
|
|
rlm@10
|
7 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
8
|
|
rlm@10
|
9 (ns clojure.core.protocols)
|
|
rlm@10
|
10
|
|
rlm@10
|
11 (defprotocol InternalReduce
|
|
rlm@10
|
12 "Protocol for concrete seq types that can reduce themselves
|
|
rlm@10
|
13 faster than first/next recursion. Called by clojure.core/reduce."
|
|
rlm@10
|
14 (internal-reduce [seq f start]))
|
|
rlm@10
|
15
|
|
rlm@10
|
16 (extend-protocol InternalReduce
|
|
rlm@10
|
17 nil
|
|
rlm@10
|
18 (internal-reduce
|
|
rlm@10
|
19 [s f val]
|
|
rlm@10
|
20 val)
|
|
rlm@10
|
21
|
|
rlm@10
|
22 ;; handles vectors and ranges
|
|
rlm@10
|
23 clojure.lang.IChunkedSeq
|
|
rlm@10
|
24 (internal-reduce
|
|
rlm@10
|
25 [s f val]
|
|
rlm@10
|
26 (if-let [s (seq s)]
|
|
rlm@10
|
27 (if (chunked-seq? s)
|
|
rlm@10
|
28 (recur (chunk-next s)
|
|
rlm@10
|
29 f
|
|
rlm@10
|
30 (.reduce (chunk-first s) f val))
|
|
rlm@10
|
31 (internal-reduce s f val))
|
|
rlm@10
|
32 val))
|
|
rlm@10
|
33
|
|
rlm@10
|
34 clojure.lang.StringSeq
|
|
rlm@10
|
35 (internal-reduce
|
|
rlm@10
|
36 [str-seq f val]
|
|
rlm@10
|
37 (let [s (.s str-seq)]
|
|
rlm@10
|
38 (loop [i (.i str-seq)
|
|
rlm@10
|
39 val val]
|
|
rlm@10
|
40 (if (< i (.length s))
|
|
rlm@10
|
41 (recur (inc i) (f val (.charAt s i)))
|
|
rlm@10
|
42 val))))
|
|
rlm@10
|
43
|
|
rlm@10
|
44 clojure.lang.ArraySeq
|
|
rlm@10
|
45 (internal-reduce
|
|
rlm@10
|
46 [a-seq f val]
|
|
rlm@10
|
47 (let [^objects arr (.array a-seq)]
|
|
rlm@10
|
48 (loop [i (.index a-seq)
|
|
rlm@10
|
49 val val]
|
|
rlm@10
|
50 (if (< i (alength arr))
|
|
rlm@10
|
51 (recur (inc i) (f val (aget arr i)))
|
|
rlm@10
|
52 val))))
|
|
rlm@10
|
53
|
|
rlm@10
|
54 java.lang.Object
|
|
rlm@10
|
55 (internal-reduce
|
|
rlm@10
|
56 [s f val]
|
|
rlm@10
|
57 (loop [cls (class s)
|
|
rlm@10
|
58 s s
|
|
rlm@10
|
59 f f
|
|
rlm@10
|
60 val val]
|
|
rlm@10
|
61 (if-let [s (seq s)]
|
|
rlm@10
|
62 ;; roll over to faster implementation if underlying seq changes type
|
|
rlm@10
|
63 (if (identical? (class s) cls)
|
|
rlm@10
|
64 (recur cls (next s) f (f val (first s)))
|
|
rlm@10
|
65 (internal-reduce s f val))
|
|
rlm@10
|
66 val))))
|
|
rlm@10
|
67
|
|
rlm@10
|
68 (def arr-impl
|
|
rlm@10
|
69 '(internal-reduce
|
|
rlm@10
|
70 [a-seq f val]
|
|
rlm@10
|
71 (let [arr (.array a-seq)]
|
|
rlm@10
|
72 (loop [i (.index a-seq)
|
|
rlm@10
|
73 val val]
|
|
rlm@10
|
74 (if (< i (alength arr))
|
|
rlm@10
|
75 (recur (inc i) (f val (aget arr i)))
|
|
rlm@10
|
76 val)))))
|
|
rlm@10
|
77
|
|
rlm@10
|
78 (defn- emit-array-impls*
|
|
rlm@10
|
79 [syms]
|
|
rlm@10
|
80 (apply
|
|
rlm@10
|
81 concat
|
|
rlm@10
|
82 (map
|
|
rlm@10
|
83 (fn [s]
|
|
rlm@10
|
84 [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s))
|
|
rlm@10
|
85 arr-impl])
|
|
rlm@10
|
86 syms)))
|
|
rlm@10
|
87
|
|
rlm@10
|
88 (defmacro emit-array-impls
|
|
rlm@10
|
89 [& syms]
|
|
rlm@10
|
90 `(extend-protocol InternalReduce
|
|
rlm@10
|
91 ~@(emit-array-impls* syms)))
|
|
rlm@10
|
92
|
|
rlm@10
|
93 (emit-array-impls int long float double byte char boolean)
|
|
rlm@10
|
94
|
