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 ;;; a generic vector implementation for vectors of primitives

    10 

    11 (in-ns 'clojure.core)

    12 

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

    14 

    15 (deftype VecNode [edit arr])

    16 

    17 (def EMPTY-NODE (VecNode. nil (object-array 32)))

    18 

    19 (definterface IVecImpl

    20   (^int tailoff [])

    21   (arrayFor [^int i])

    22   (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode])

    23   (popTail [^int level node])

    24   (newPath [edit ^int level node])

    25   (doAssoc [^int level node ^int i val]))

    26 

    27 (definterface ArrayManager

    28   (array [^int size])

    29   (^int alength [arr])

    30   (aclone [arr])

    31   (aget [arr ^int i])

    32   (aset [arr ^int i val]))

    33 

    34 (deftype ArrayChunk [^clojure.core.ArrayManager am arr ^int off ^int end]

    35   

    36   clojure.lang.Indexed

    37   (nth [_ i] (.aget am arr (+ off i)))

    38   

    39   (count [_] (- end off))

    40 

    41   clojure.lang.IChunk

    42   (dropFirst [_]

    43     (if (= off end)

    44       (throw (IllegalStateException. "dropFirst of empty chunk"))

    45       (new ArrayChunk am arr (inc off) end)))

    46   

    47   (reduce [_ f init]

    48     (loop [ret init i off]

    49       (if (< i end)

    50         (recur (f ret (.aget am arr i)) (inc i))

    51         ret)))

    52   )

    53 

    54 (deftype VecSeq [^clojure.core.ArrayManager am ^clojure.core.IVecImpl vec anode ^int i ^int offset] 

    55   :no-print true

    56 

    57   clojure.core.protocols.InternalReduce

    58   (internal-reduce

    59    [_ f val]

    60    (loop [result val

    61           aidx offset]

    62      (if (< aidx (count vec))

    63        (let [node (.arrayFor vec aidx)

    64              result (loop [result result

    65                            node-idx (bit-and (int 0x1f) aidx)]

    66                       (if (< node-idx (.alength am node))

    67                         (recur (f result (.aget am node node-idx)) (inc node-idx))

    68                         result))]

    69          (recur result (bit-and (int 0xffe0) (+ aidx (int 32)))))

    70        result)))

    71   

    72   clojure.lang.ISeq

    73   (first [_] (.aget am anode offset))

    74   (next [this] 

    75     (if (< (inc offset) (.alength am anode))

    76       (new VecSeq am vec anode i (inc offset))

    77       (.chunkedNext this)))

    78   (more [this]

    79     (let [s (.next this)]

    80       (or s (clojure.lang.PersistentList/EMPTY))))

    81   (cons [this o]

    82     (clojure.lang.Cons. o this))

    83   (count [this]

    84     (loop [i 1

    85            s (next this)]

    86       (if s

    87         (if (instance? clojure.lang.Counted s)

    88           (+ i (.count s))

    89           (recur (inc i) (next s)))

    90         i)))

    91   (equiv [this o]

    92     (cond

    93      (identical? this o) true

    94      (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))

    95      (loop [me this

    96             you (seq o)]

    97        (if (nil? me)

    98          (nil? you)

    99          (and (clojure.lang.Util/equiv (first me) (first you))

   100               (recur (next me) (next you)))))

   101      :else false))

   102   (empty [_]

   103     clojure.lang.PersistentList/EMPTY)

   104 

   105 

   106   clojure.lang.Seqable

   107   (seq [this] this)

   108 

   109   clojure.lang.IChunkedSeq

   110   (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode)))

   111   (chunkedNext [_] 

   112    (let [nexti (+ i (.alength am anode))]

   113      (when (< nexti (count vec))

   114        (new VecSeq am vec (.arrayFor vec nexti) nexti 0))))

   115   (chunkedMore [this]

   116     (let [s (.chunkedNext this)]

   117       (or s (clojure.lang.PersistentList/EMPTY)))))

   118 

   119 (defmethod print-method ::VecSeq [v w]

   120   ((get (methods print-method) clojure.lang.ISeq) v w))

   121 

   122 (deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta]

   123   Object

   124   (equals [this o]

   125     (cond 

   126      (identical? this o) true

   127      (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o))

   128        (and (= cnt (count o))

   129             (loop [i (int 0)]

   130               (cond

   131                (= i cnt) true

   132                (.equals (.nth this i) (nth o i)) (recur (inc i))

   133                :else false)))

   134      (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))

   135        (.equals (seq this) (seq o))

   136      :else false))

   137 

   138   ;todo - cache

   139   (hashCode [this]

   140     (loop [hash (int 1) i (int 0)]

   141       (if (= i cnt)

   142         hash

   143         (let [val (.nth this i)]

   144           (recur (unchecked-add (unchecked-multiply (int 31) hash) 

   145                                 (clojure.lang.Util/hash val)) 

   146                  (inc i))))))

   147 

   148   clojure.lang.Counted

   149   (count [_] cnt)

   150 

   151   clojure.lang.IMeta

   152   (meta [_] _meta)

   153 

   154   clojure.lang.IObj

   155   (withMeta [_ m] (new Vec am cnt shift root tail m))

   156 

   157   clojure.lang.Indexed

   158   (nth [this i]

   159     (let [a (.arrayFor this i)]

   160       (.aget am a (bit-and i (int 0x1f)))))

   161   (nth [this i not-found]

   162        (let [z (int 0)]

   163          (if (and (>= i z) (< i (.count this)))

   164            (.nth this i)

   165            not-found)))

   166 

   167   clojure.lang.IPersistentCollection

   168   (cons [this val]

   169      (if (< (- cnt (.tailoff this)) (int 32))

   170       (let [new-tail (.array am (inc (.alength am tail)))]

   171         (System/arraycopy tail 0 new-tail 0 (.alength am tail))

   172         (.aset am new-tail (.alength am tail) val)

   173         (new Vec am (inc cnt) shift root new-tail (meta this)))

   174       (let [tail-node (VecNode. (.edit root) tail)] 

   175         (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root?

   176           (let [new-root (VecNode. (.edit root) (object-array 32))]

   177             (doto ^objects (.arr new-root)

   178               (aset 0 root)

   179               (aset 1 (.newPath this (.edit root) shift tail-node)))

   180             (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this)))

   181           (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) 

   182                  (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this))))))

   183 

   184   (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil))                             

   185   (equiv [this o]

   186     (cond 

   187      (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o))

   188        (and (= cnt (count o))

   189             (loop [i (int 0)]

   190               (cond

   191                (= i cnt) true

   192                (= (.nth this i) (nth o i)) (recur (inc i))

   193                :else false)))

   194      (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))

   195        (= (seq this) (seq o))

   196      :else false))

   197 

   198   clojure.lang.IPersistentStack

   199   (peek [this]

   200     (when (> cnt (int 0)) 

   201       (.nth this (dec cnt))))

   202 

   203   (pop [this]

   204    (cond

   205     (zero? cnt) 

   206       (throw (IllegalStateException. "Can't pop empty vector"))

   207     (= 1 cnt) 

   208       (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this))

   209     (> (- cnt (.tailoff this)) 1)

   210       (let [new-tail (.array am (dec (.alength am tail)))]

   211         (System/arraycopy tail 0 new-tail 0 (.alength am new-tail))

   212         (new Vec am (dec cnt) shift root new-tail (meta this)))

   213     :else

   214       (let [new-tail (.arrayFor this (- cnt 2))

   215             new-root ^clojure.core.VecNode (.popTail this shift root)]

   216         (cond

   217          (nil? new-root) 

   218            (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this))

   219          (and (> shift 5) (nil? (aget ^objects (.arr new-root) 1)))

   220            (new Vec am (dec cnt) (- shift 5) (aget ^objects (.arr new-root) 0) new-tail (meta this))

   221          :else

   222            (new Vec am (dec cnt) shift new-root new-tail (meta this))))))

   223 

   224   clojure.lang.IPersistentVector

   225   (assocN [this i val]

   226     (cond 

   227      (and (<= (int 0) i) (< i cnt))

   228        (if (>= i (.tailoff this))

   229          (let [new-tail (.array am (.alength am tail))]

   230            (System/arraycopy tail 0 new-tail 0 (.alength am tail))

   231            (.aset am new-tail (bit-and i (int 0x1f)) val)

   232            (new Vec am cnt shift root new-tail (meta this)))

   233          (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this)))

   234      (= i cnt) (.cons this val)

   235      :else (throw (IndexOutOfBoundsException.))))

   236   

   237   clojure.lang.Reversible

   238   (rseq [this]

   239         (if (> (.count this) 0)

   240           (clojure.lang.APersistentVector$RSeq. this (dec (.count this)))

   241           nil))

   242   

   243   clojure.lang.Associative

   244   (assoc [this k v]

   245     (if (clojure.lang.Util/isInteger k)

   246       (.assocN this k v)

   247       (throw (IllegalArgumentException. "Key must be integer"))))

   248   (containsKey [this k]

   249     (and (clojure.lang.Util/isInteger k)

   250          (<= 0 (int k))

   251          (< (int k) cnt)))

   252   (entryAt [this k]

   253     (if (.containsKey this k)

   254       (clojure.lang.MapEntry. k (.nth this (int k)))

   255       nil))

   256 

   257   clojure.lang.ILookup

   258   (valAt [this k not-found]

   259     (if (clojure.lang.Util/isInteger k)

   260       (let [i (int k)]

   261         (if (and (>= i 0) (< i cnt))

   262           (.nth this i)

   263           not-found))

   264       not-found))

   265 

   266   (valAt [this k] (.valAt this k nil))

   267 

   268   clojure.lang.IFn

   269   (invoke [this k]

   270     (if (clojure.lang.Util/isInteger k)

   271       (let [i (int k)]

   272         (if (and (>= i 0) (< i cnt))

   273           (.nth this i)

   274           (throw (IndexOutOfBoundsException.))))

   275       (throw (IllegalArgumentException. "Key must be integer"))))

   276 

   277   

   278   clojure.lang.Seqable

   279   (seq [this] 

   280     (if (zero? cnt) 

   281       nil

   282       (VecSeq. am this (.arrayFor this 0) 0 0)))

   283 

   284   clojure.lang.Sequential ;marker, no methods

   285 

   286   clojure.core.IVecImpl

   287   (tailoff [_] 

   288     (- cnt (.alength am tail)))

   289 

   290   (arrayFor [this i]

   291     (if (and  (<= (int 0) i) (< i cnt))

   292       (if (>= i (.tailoff this))

   293         tail

   294         (loop [node root level shift]

   295           (if (zero? level)

   296             (.arr node)

   297             (recur (aget ^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) 

   298                    (- level (int 5))))))

   299       (throw (IndexOutOfBoundsException.))))

   300 

   301   (pushTail [this level parent tailnode]

   302     (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f))

   303           parent ^clojure.core.VecNode parent

   304           ret (VecNode. (.edit parent) (aclone ^objects (.arr parent)))

   305           node-to-insert (if (= level (int 5))

   306                            tailnode

   307                            (let [child (aget ^objects (.arr parent) subidx)]

   308                              (if child

   309                                (.pushTail this (- level (int 5)) child tailnode)

   310                                (.newPath this (.edit root) (- level (int 5)) tailnode))))]

   311       (aset ^objects (.arr ret) subidx node-to-insert)

   312       ret))

   313 

   314   (popTail [this level node]

   315     (let [node ^clojure.core.VecNode node

   316           subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))]

   317       (cond

   318        (> level 5) 

   319          (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))]

   320            (if (and (nil? new-child) (zero? subidx))

   321              nil

   322              (let [arr (aclone ^objects (.arr node))]

   323                (aset arr subidx new-child)

   324                (VecNode. (.edit root) arr))))

   325        (zero? subidx) nil

   326        :else (let [arr (aclone ^objects (.arr node))]

   327                (aset arr subidx nil)

   328                (VecNode. (.edit root) arr)))))

   329 

   330   (newPath [this edit ^int level node]

   331     (if (zero? level)

   332       node

   333       (let [ret (VecNode. edit (object-array 32))]

   334         (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node))

   335         ret)))

   336 

   337   (doAssoc [this level node i val]

   338     (let [node ^clojure.core.VecNode node]       

   339       (if (zero? level)

   340         ;on this branch, array will need val type

   341         (let [arr (.aclone am (.arr node))]

   342           (.aset am arr (bit-and i (int 0x1f)) val)

   343           (VecNode. (.edit node) arr))

   344         (let [arr (aclone ^objects (.arr node))

   345               subidx (bit-and (bit-shift-right i level) (int 0x1f))]

   346           (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val))

   347           (VecNode. (.edit node) arr)))))

   348 

   349   java.lang.Comparable

   350   (compareTo [this o]

   351     (if (identical? this o)

   352       0

   353       (let [#^clojure.lang.IPersistentVector v (cast clojure.lang.IPersistentVector o)

   354             vcnt (.count v)]

   355         (cond

   356           (< cnt vcnt) -1

   357           (> cnt vcnt) 1

   358           :else

   359             (loop [i (int 0)]

   360               (if (= i cnt)

   361                 0

   362                 (let [comp (clojure.lang.Util/compare (.nth this i) (.nth v i))]

   363                   (if (= 0 comp)

   364                     (recur (inc i))

   365                     comp))))))))

   366 

   367   java.lang.Iterable

   368   (iterator [this]

   369     (let [i (java.util.concurrent.atomic.AtomicInteger. 0)]

   370       (reify java.util.Iterator

   371         (hasNext [_] (< (.get i) cnt))

   372         (next [_] (.nth this (dec (.incrementAndGet i))))

   373         (remove [_] (throw (UnsupportedOperationException.))))))

   374 

   375   java.util.Collection

   376   (contains [this o] (boolean (some #(= % o) this)))

   377   (containsAll [this c] (every? #(.contains this %) c))

   378   (isEmpty [_] (zero? cnt))

   379   (toArray [this] (into-array Object this))

   380   (toArray [this arr]

   381     (if (>= (count arr) cnt)

   382       (do

   383         (dotimes [i cnt]

   384           (aset arr i (.nth this i)))

   385         arr)

   386       (into-array Object this)))

   387   (size [_] cnt)

   388   (add [_ o] (throw (UnsupportedOperationException.)))

   389   (addAll [_ c] (throw (UnsupportedOperationException.)))

   390   (clear [_] (throw (UnsupportedOperationException.)))

   391   (^boolean remove [_ o] (throw (UnsupportedOperationException.)))

   392   (removeAll [_ c] (throw (UnsupportedOperationException.)))

   393   (retainAll [_ c] (throw (UnsupportedOperationException.)))

   394 

   395   java.util.List

   396   (get [this i] (.nth this i))

   397   (indexOf [this o]

   398     (loop [i (int 0)]

   399       (cond

   400         (== i cnt) -1

   401         (= o (.nth this i)) i

   402         :else (recur (inc i)))))

   403   (lastIndexOf [this o]

   404     (loop [i (dec cnt)]

   405       (cond

   406         (< i 0) -1

   407         (= o (.nth this i)) i

   408         :else (recur (dec i)))))

   409   (listIterator [this] (.listIterator this 0))

   410   (listIterator [this i]

   411     (let [i (java.util.concurrent.atomic.AtomicInteger. i)]

   412       (reify java.util.ListIterator

   413         (hasNext [_] (< (.get i) cnt))

   414         (hasPrevious [_] (pos? i))

   415         (next [_] (.nth this (dec (.incrementAndGet i))))

   416         (nextIndex [_] (.get i))

   417         (previous [_] (.nth this (.decrementAndGet i)))

   418         (previousIndex [_] (dec (.get i)))

   419         (add [_ e] (throw (UnsupportedOperationException.)))

   420         (remove [_] (throw (UnsupportedOperationException.)))

   421         (set [_ e] (throw (UnsupportedOperationException.))))))

   422   (subList [this a z] (subvec this a z))

   423   (add [_ i o] (throw (UnsupportedOperationException.)))

   424   (addAll [_ i c] (throw (UnsupportedOperationException.)))

   425   (^Object remove [_ ^int i] (throw (UnsupportedOperationException.)))

   426   (set [_ i e] (throw (UnsupportedOperationException.)))

   427 )

   428 

   429 (defmethod print-method ::Vec [v w]

   430   ((get (methods print-method) clojure.lang.IPersistentVector) v w))

   431 

   432 (defmacro mk-am {:private true} [t]

   433   (let [garr (gensym)

   434         tgarr (with-meta garr {:tag (symbol (str t "s"))})]

   435     `(reify clojure.core.ArrayManager

   436             (array [_ size#] (~(symbol (str t "-array")) size#))

   437             (alength [_ ~garr] (alength ~tgarr))

   438             (aclone [_ ~garr] (aclone ~tgarr))

   439             (aget [_ ~garr i#] (aget ~tgarr i#))

   440             (aset [_ ~garr i# val#] (aset ~tgarr i# (~t val#))))))

   441 

   442 (def ^{:private true} ams

   443      {:int (mk-am int)

   444       :long (mk-am long)

   445       :float (mk-am float)

   446       :double (mk-am double)

   447       :byte (mk-am byte)

   448       :short (mk-am short)

   449       :char (mk-am char)

   450       :boolean (mk-am boolean)})

   451 

   452 (defn vector-of 

   453   "Creates a new vector of a single primitive type t, where t is one

   454   of :int :long :float :double :byte :short :char or :boolean. The

   455   resulting vector complies with the interface of vectors in general,

   456   but stores the values unboxed internally."

   457   {:added "1.2"}

   458   [t]

   459   (let [am ^clojure.core.ArrayManager (ams t)]

   460     (Vec. am 0 5 EMPTY-NODE (.array am 0) nil)))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children