Mercurial > lasercutter

     1 ;   Copyright (c) Rich Hickey. All rights reserved.

     2 ;   The use and distribution terms for this software are covered by the

     3 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     4 ;   which can be found in the file epl-v10.html at the root of this distribution.

     5 ;   By using this software in any fashion, you are agreeing to be bound by

     6 ;   the terms of this license.

     7 ;   You must not remove this notice, or any other, from this software.

     8 

     9 (ns clojure.core.protocols)

    10 

    11 (defprotocol InternalReduce

    12   "Protocol for concrete seq types that can reduce themselves

    13    faster than first/next recursion. Called by clojure.core/reduce."

    14   (internal-reduce [seq f start]))

    15 

    16 (extend-protocol InternalReduce

    17   nil

    18   (internal-reduce

    19    [s f val]

    20    val)

    21   

    22   ;; handles vectors and ranges

    23   clojure.lang.IChunkedSeq

    24   (internal-reduce

    25    [s f val]

    26    (if-let [s (seq s)]

    27      (if (chunked-seq? s)

    28        (recur (chunk-next s)

    29               f

    30               (.reduce (chunk-first s) f val))

    31        (internal-reduce s f val))

    32      val))

    33  

    34   clojure.lang.StringSeq

    35   (internal-reduce

    36    [str-seq f val]

    37    (let [s (.s str-seq)]

    38      (loop [i (.i str-seq)

    39             val val]

    40        (if (< i (.length s))

    41          (recur (inc i) (f val (.charAt s i)))

    42          val))))

    43   

    44   clojure.lang.ArraySeq

    45   (internal-reduce

    46        [a-seq f val]

    47        (let [^objects arr (.array a-seq)]

    48          (loop [i (.index a-seq)

    49                 val val]

    50            (if (< i (alength arr))

    51              (recur (inc i) (f val (aget arr i)))

    52              val))))

    53   

    54   java.lang.Object

    55   (internal-reduce

    56    [s f val]

    57    (loop [cls (class s)

    58           s s

    59           f f

    60           val val]

    61      (if-let [s (seq s)]

    62        ;; roll over to faster implementation if underlying seq changes type

    63        (if (identical? (class s) cls)

    64          (recur cls (next s) f (f val (first s)))

    65          (internal-reduce s f val))

    66        val))))

    67 

    68 (def arr-impl

    69   '(internal-reduce

    70        [a-seq f val]

    71        (let [arr (.array a-seq)]

    72          (loop [i (.index a-seq)

    73                 val val]

    74            (if (< i (alength arr))

    75              (recur (inc i) (f val (aget arr i)))

    76              val)))))

    77 

    78 (defn- emit-array-impls*

    79   [syms]

    80   (apply

    81    concat

    82    (map

    83     (fn [s]

    84       [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s))

    85        arr-impl])

    86     syms)))

    87 

    88 (defmacro emit-array-impls

    89   [& syms]

    90   `(extend-protocol InternalReduce

    91      ~@(emit-array-impls* syms)))

    92 

    93 (emit-array-impls int long float double byte char boolean)

    94
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children