diff options
29 files changed, 906 insertions, 682 deletions
diff --git a/clojure.iml b/clojure.iml index 83686b75..183e1ddd 100644 --- a/clojure.iml +++ b/clojure.iml @@ -36,9 +36,5 @@ </library> </orderEntry> </component> - <component name="VcsManagerConfiguration"> - <option name="ACTIVE_VCS_NAME" value="svn" /> - <option name="USE_PROJECT_VCS" value="false" /> - </component> </module> diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 55d4d588..eaab3aaf 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -847,19 +847,19 @@ ;; reduce is defined again later after InternalReduce loads (defn ^:private ^:static reduce1 - ([f coll] - (let [s (seq coll)] - (if s + ([f coll] + (let [s (seq coll)] + (if s (reduce1 f (first s) (next s)) - (f)))) - ([f val coll] - (let [s (seq coll)] - (if s - (if (chunked-seq? s) - (recur f - (.reduce (chunk-first s) f val) - (chunk-next s)) - (recur f (f val (first s)) (next s))) + (f)))) + ([f val coll] + (let [s (seq coll)] + (if s + (if (chunked-seq? s) + (recur f + (.reduce (chunk-first s) f val) + (chunk-next s)) + (recur f (f val (first s)) (next s))) val)))) (defn reverse @@ -4884,6 +4884,8 @@ :descendants (tf (:descendants h) parent ta tag td)}) h)))) +(declare flatten) + (defn underive "Removes a parent/child relationship between parent and tag. h must be a hierarchy obtained from make-hierarchy, if not @@ -4891,20 +4893,18 @@ {:added "1.0"} ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil) ([h tag parent] - (let [tp (:parents h) - td (:descendants h) - ta (:ancestors h) - tf (fn [m source sources target targets] - (reduce1 - (fn [ret k] - (assoc ret k - (reduce1 disj (get targets k) (cons target (targets target))))) - m (cons source (sources source))))] - (if (contains? (tp tag) parent) - {:parent (assoc (:parents h) tag (disj (get tp tag) parent)) - :ancestors (tf (:ancestors h) tag td parent ta) - :descendants (tf (:descendants h) parent ta tag td)} - h)))) + (let [parentMap (:parents h) + childsParents (if (parentMap tag) + (disj (parentMap tag) parent) #{}) + newParents (if (not-empty childsParents) + (assoc parentMap tag childsParents) + (dissoc parentMap tag)) + deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %))) + (seq newParents)))] + (if (contains? (parentMap tag) parent) + (reduce1 #(apply derive %1 %2) (make-hierarchy) + (partition 2 deriv-seq)) + h)))) (defn distinct? @@ -5745,7 +5745,6 @@ (load "gvec") ;; redefine reduce with internal-reduce - (defn reduce "f should be a function of 2 arguments. If val is not supplied, returns the result of applying f to the first 2 items in coll, then @@ -5802,11 +5801,11 @@ (defn spit "Opposite of slurp. Opens f with writer, writes content, then - closes f." + closes f. Options passed to clojure.java.io/writer." {:added "1.2"} [f content & options] (with-open [#^java.io.Writer w (apply jio/writer f options)] - (.write w content))) + (.write w (str content)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;; (defn future-call @@ -5833,9 +5832,8 @@ invoke the body in another thread, and will cache the result and return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block." - {:added "1.1" - :static true} - [& body] `(future-call (fn [] ~@body))) + {:added "1.1"} + [& body] `(future-call (^{:once true} fn* [] ~@body))) (defn future-cancel diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index f556f25a..344f9811 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -70,11 +70,11 @@ or more method bodies: protocol-or-interface-or-Object - (methodName [args*] body)* + (methodName [args+] body)* Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for - methods of Object. Note that a parameter must be supplied to + methods of Object. Note that the first parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method @@ -97,12 +97,12 @@ (str (let [f \"foo\"] (reify Object - (toString [] f)))) + (toString [this] f)))) == \"foo\" (seq (let [f \"foo\"] (reify clojure.lang.Seqable - (seq [] (seq f))))) + (seq [this] (seq f))))) == (\\f \\o \\o))" {:added "1.2"} [& opts+specs] @@ -151,14 +151,8 @@ [(eqhash [[i m]] [i (conj m - `(hashCode [this#] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields)))) - `(equals [this# ~gs] - (boolean - (or (identical? this# ~gs) - (when (identical? (class this#) (class ~gs)) - (let [~gs ~(with-meta gs {:tag tagname})] - (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields) - (= ~'__extmap (. ~gs ~'__extmap)))))))))]) + `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#)) + `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))]) (iobj [[i m]] [(conj i 'clojure.lang.IObj) (conj m `(meta [this#] ~'__meta) @@ -190,13 +184,19 @@ `(count [this#] (+ ~(count base-fields) (count ~'__extmap))) `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname))))) `(cons [this# e#] ((var imap-cons) this# e#)) - `(equiv [this# o#] (.equals this# o#)) + `(equiv [this# ~gs] + (boolean + (or (identical? this# ~gs) + (when (identical? (class this#) (class ~gs)) + (let [~gs ~(with-meta gs {:tag tagname})] + (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields) + (= ~'__extmap (. ~gs ~'__extmap)))))))) `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#)))) `(entryAt [this# k#] (let [v# (.valAt this# k# this#)] (when-not (identical? this# v#) (clojure.lang.MapEntry. k# v#)))) - `(seq [this#] (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] - ~'__extmap)) + `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] + ~'__extmap))) `(assoc [this# k# ~gs] (condp identical? k# ~@(mapcat (fn [fld] @@ -212,7 +212,7 @@ (conj m `(size [this#] (.count this#)) `(isEmpty [this#] (= 0 (.count this#))) - `(containsValue [this# v#] (-> this# vals (.contains v#))) + `(containsValue [this# v#] (boolean (some #{v#} (vals this#)))) `(get [this# k#] (.valAt this# k#)) `(put [this# k# v#] (throw (UnsupportedOperationException.))) `(remove [this# k#] (throw (UnsupportedOperationException.))) @@ -581,18 +581,18 @@ \"A doc string for AProtocol abstraction\" ;method signatures - (bar [a b] \"bar docs\") - (baz [a] [a b] [a b c] \"baz docs\")) + (bar [this a b] \"bar docs\") + (baz [this a] [this a b] [this a b c] \"baz docs\")) No implementations are provided. Docs can be specified for the protocol overall and for each method. The above yields a set of polymorphic functions and a protocol object. All are namespace-qualified by the ns enclosing the definition The resulting - functions dispatch on the type of their first argument, and thus - must have at least one argument. defprotocol is dynamic, has no - special compile-time effect, and defines no new types or classes - Implementations of the protocol methods can be provided using - extend. + functions dispatch on the type of their first argument, which is + required and corresponds to the implicit target object ('this' in + Java parlance). defprotocol is dynamic, has no special compile-time + effect, and defines no new types or classes. Implementations of + the protocol methods can be provided using extend. defprotocol will automatically generate a corresponding interface, with the same name as the protocol, i.e. given a protocol: @@ -604,23 +604,25 @@ reify, as they support the protocol directly: (defprotocol P - (foo [x]) - (bar-me [x] [x y])) + (foo [this]) + (bar-me [this] [this y])) (deftype Foo [a b c] P - (foo [] a) - (bar-me [] b) - (bar-me [y] (+ c y))) + (foo [this] a) + (bar-me [this] b) + (bar-me [this y] (+ c y))) - (bar-me (Foo 1 2 3) 42) + (bar-me (Foo. 1 2 3) 42) + => 45 (foo (let [x 42] (reify P - (foo [] 17) - (bar-me [] x) - (bar-me [y] x))))" + (foo [this] 17) + (bar-me [this] x) + (bar-me [this y] x)))) + => 17" {:added "1.2"} [name & opts+sigs] (emit-protocol name opts+sigs)) @@ -729,13 +731,13 @@ "Useful when you want to provide several implementations of the same protocol all at once. Takes a single protocol and the implementation of that protocol for one or more types. Expands into calls to - extend-type and extend-class: + extend-type: (extend-protocol Protocol - ::AType + AType (foo [x] ...) (bar [x y] ...) - ::BType + BType (foo [x] ...) (bar [x y] ...) AClass @@ -748,13 +750,13 @@ expands into: (do - (clojure.core/extend-type ::AType Protocol + (clojure.core/extend-type AType Protocol (foo [x] ...) (bar [x y] ...)) - (clojure.core/extend-type ::BType Protocol + (clojure.core/extend-type BType Protocol (foo [x] ...) (bar [x y] ...)) - (clojure.core/extend-class AClass Protocol + (clojure.core/extend-type AClass Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type nil Protocol diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj index a1e0fcdb..052d0cbb 100644 --- a/src/clj/clojure/genclass.clj +++ b/src/clj/clojure/genclass.clj @@ -90,7 +90,18 @@ strx (str "java.lang." strx)))))) +;; someday this can be made codepoint aware +(defn- valid-java-method-name + [^String s] + (= s (clojure.lang.Compiler/munge s))) + +(defn- validate-generate-class-options + [{:keys [methods]}] + (let [[mname] (remove valid-java-method-name (map (comp str first) methods))] + (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname)))))) + (defn- generate-class [options-map] + (validate-generate-class-options options-map) (let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)} {:keys [name extends implements constructors methods main factory state init exposes exposes-methods prefix load-impl-ns impl-ns post-init]} diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj index 1b3443a5..fa1ba03e 100644 --- a/src/clj/clojure/gvec.clj +++ b/src/clj/clojure/gvec.clj @@ -19,7 +19,7 @@ (definterface IVecImpl (^int tailoff []) (arrayFor [^int i]) - (pushTail [^int level parent tailnode]) + (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode]) (popTail [^int level node]) (newPath [edit ^int level node]) (doAssoc [^int level node ^int i val])) @@ -119,7 +119,7 @@ (defmethod print-method ::VecSeq [v w] ((get (methods print-method) clojure.lang.ISeq) v w)) -(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift root tail _meta] +(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta] Object (equals [this o] (cond @@ -212,7 +212,7 @@ (new Vec am (dec cnt) shift root new-tail (meta this))) :else (let [new-tail (.arrayFor this (- cnt 2)) - new-root (.popTail this shift root)] + new-root ^clojure.core.VecNode (.popTail this shift root)] (cond (nil? new-root) (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this)) @@ -300,6 +300,7 @@ (pushTail [this level parent tailnode] (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f)) + parent ^clojure.core.VecNode parent ret (VecNode. (.edit parent) (aclone ^objects (.arr parent))) node-to-insert (if (= level (int 5)) tailnode @@ -311,7 +312,8 @@ ret)) (popTail [this level node] - (let [subidx (bit-and (bit-shift-right (- cnt 2) level) (int 0x1f))] + (let [node ^clojure.core.VecNode node + subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))] (cond (> level 5) (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))] @@ -332,16 +334,17 @@ (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node)) ret))) - (doAssoc [this level node i val] - (if (zero? level) - ;on this branch, array will need val type - (let [arr (.aclone am (.arr node))] - (.aset am arr (bit-and i (int 0x1f)) val) - (VecNode. (.edit node) arr)) - (let [arr (aclone ^objects (.arr node)) - subidx (bit-and (bit-shift-right i level) (int 0x1f))] - (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val)) - (VecNode. (.edit node) arr)))) + (doAssoc [this level node i val] + (let [node ^clojure.core.VecNode node] + (if (zero? level) + ;on this branch, array will need val type + (let [arr (.aclone am (.arr node))] + (.aset am arr (bit-and i (int 0x1f)) val) + (VecNode. (.edit node) arr)) + (let [arr (aclone ^objects (.arr node)) + subidx (bit-and (bit-shift-right i level) (int 0x1f))] + (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val)) + (VecNode. (.edit node) arr))))) java.lang.Comparable (compareTo [this o] diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index 4d6c551f..5f36755e 100644 --- a/src/clj/clojure/java/io.clj +++ b/src/clj/clojure/java/io.clj @@ -33,8 +33,8 @@ (defprotocol ^{:added "1.2"} Coercions "Coerce between various 'resource-namish' things." - (^{:tag File, :added "1.2"} as-file [x] "Coerce argument to a file.") - (^{:tag URL, :added "1.2"} as-url [x] "Coerce argument to a URL.")) + (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.") + (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL.")) (extend-protocol Coercions nil @@ -259,8 +259,8 @@ (extend Socket IOFactory (assoc default-streams-impl - :make-input-stream (fn [^Socket x opts] (.getInputStream x)) - :output-stream (fn [^Socket x opts] (output-stream (.getOutputStream x) opts)))) + :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts)) + :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts)))) (extend byte-array-type IOFactory diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index 11d908a5..004629df 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -11,8 +11,9 @@ :doc "Conveniently launch a sub-process providing its stdin and collecting its stdout"} clojure.java.shell - (:use [clojure.java.io :only (as-file)]) - (:import (java.io InputStreamReader OutputStreamWriter))) + (:use [clojure.java.io :only (as-file copy)]) + (:import (java.io OutputStreamWriter ByteArrayOutputStream StringWriter) + (java.nio.charset Charset))) (def *sh-dir* nil) (def *sh-env* nil) @@ -31,11 +32,6 @@ collecting its stdout"} `(binding [*sh-env* ~env] ~@forms)) -(defn- stream-seq - "Takes an InputStream and returns a lazy seq of integers from the stream." - [stream] - (take-while #(>= % 0) (repeatedly #(.read stream)))) - (defn- aconcat "Concatenates arrays of given type." [type & xs] @@ -48,11 +44,12 @@ collecting its stdout"} (defn- parse-args [args] - (let [default-opts {:out "UTF-8" :dir *sh-dir* :env *sh-env*} + (let [default-encoding "UTF-8" ;; see sh doc string + default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*} [cmd opts] (split-with string? args)] [cmd (merge default-opts (apply hash-map opts))])) -(defn- as-env-string +(defn- ^"[Ljava.lang.String;" as-env-strings "Helper so that callers can pass a Clojure map for the :env to sh." [arg] (cond @@ -60,22 +57,47 @@ collecting its stdout"} (map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg)) true arg)) +(defn- stream-to-bytes + [in] + (with-open [bout (ByteArrayOutputStream.)] + (copy in bout) + (.toByteArray bout))) + +(defn- stream-to-string + ([in] (stream-to-string in (.name (Charset/defaultCharset)))) + ([in enc] + (with-open [bout (StringWriter.)] + (copy in bout :encoding enc) + (.toString bout)))) + +(defn- stream-to-enc + [stream enc] + (if (= enc :bytes) + (stream-to-bytes stream) + (stream-to-string stream enc))) + (defn sh "Passes the given strings to Runtime.exec() to launch a sub-process. Options are - :in may be given followed by a String specifying text to be fed to the - sub-process's stdin. - :out option may be given followed by :bytes or a String. If a String - is given, it will be used as a character encoding name (for - example \"UTF-8\" or \"ISO-8859-1\") to convert the - sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored in - a byte array and returned. Defaults to UTF-8. - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. + :in may be given followed by a String or byte array specifying input + to be fed to the sub-process's stdin. + :in-enc option may be given followed by a String, used as a character + encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to + convert the input string specified by the :in option to the + sub-process's stdin. Defaults to UTF-8. + If the :in option provides a byte array, then the bytes are passed + unencoded, and this option is ignored. + :out-enc option may be given followed by :bytes or a String. If a + String is given, it will be used as a character encoding + name (for example \"UTF-8\" or \"ISO-8859-1\") to convert + the sub-process's stdout to a String which is returned. + If :bytes is given, the sub-process's stdout will be stored + in a byte array and returned. Defaults to UTF-8. + :env override the process env with a map (or the underlying Java + String[] if you are a masochist). + :dir override the process dir with a String or java.io.File. You can bind :env or :dir for multiple operations using with-sh-env and with-sh-dir. @@ -83,30 +105,29 @@ collecting its stdout"} sh returns a map of :exit => sub-process's exit code :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (as byte[] or String)" + :err => sub-process's stderr (String via platform default encoding)" {:added "1.2"} [& args] (let [[cmd opts] (parse-args args) proc (.exec (Runtime/getRuntime) - (into-array cmd) - (as-env-string (:env opts)) - (as-file (:dir opts)))] - (println opts) - (if (:in opts) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc))] - (.write osw (:in opts))) + ^"[Ljava.lang.String;" (into-array cmd) + (as-env-strings (:env opts)) + (as-file (:dir opts))) + {:keys [in in-enc out-enc]} opts] + (if in + (future + (if (instance? (class (byte-array 0)) in) + (with-open [os (.getOutputStream proc)] + (.write os ^"[B" in)) + (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String in-enc)] + (.write osw ^String in)))) (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] - (let [[out err] - (if (= (:out opts) :bytes) - (for [strm [stdout stderr]] - (into-array Byte/TYPE (map byte (stream-seq strm)))) - (for [strm [stdout stderr]] - (apply str (map char (stream-seq - (InputStreamReader. strm (:out opts))))))) + (let [out (future (stream-to-enc stdout out-enc)) + err (future (stream-to-string stderr)) exit-code (.waitFor proc)] - {:exit exit-code :out out :err err})))) + {:exit exit-code :out @out :err @err})))) (comment @@ -115,7 +136,8 @@ collecting its stdout"} (println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) (println (sh "cat" :in "x\u25bax\n")) (println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[] +(println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars +(println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[] +(println (sh "cmd" "/c dir 1>&2")) ) diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index 61fcae75..18bd932f 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -196,6 +196,7 @@ (set! *e e))) (use '[clojure.repl :only (source apropos dir)]) (use '[clojure.java.javadoc :only (javadoc)]) + (use '[clojure.pprint :only (pp pprint)]) (prompt) (flush) (loop [] diff --git a/src/clj/clojure/pprint/pprint_base.clj b/src/clj/clojure/pprint/pprint_base.clj index 88e032d8..9ff74e85 100644 --- a/src/clj/clojure/pprint/pprint_base.clj +++ b/src/clj/clojure/pprint/pprint_base.clj @@ -311,14 +311,19 @@ and :suffix." {:added "1.2", :arglists '[[options* body]]} [& args] (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] - `(do (if (level-exceeded) + `(do (if (#'clojure.pprint/level-exceeded) (.write ^java.io.Writer *out* "#") - (binding [*current-level* (inc *current-level*) - *current-length* 0] - (start-block *out* - ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) - ~@body - (end-block *out*))) + (do + (push-thread-bindings {#'clojure.pprint/*current-level* + (inc (var-get #'clojure.pprint/*current-level*)) + #'clojure.pprint/*current-length* 0}) + (try + (#'clojure.pprint/start-block *out* + ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) + ~@body + (#'clojure.pprint/end-block *out*) + (finally + (pop-thread-bindings))))) nil))) (defn pprint-newline diff --git a/src/clj/clojure/set.clj b/src/clj/clojure/set.clj index 835e6063..af0f65f6 100644 --- a/src/clj/clojure/set.clj +++ b/src/clj/clojure/set.clj @@ -82,7 +82,7 @@ (fn [m [old new]] (if (and (not= old new) (contains? m old)) - (-> m (assoc new (m old)) (dissoc old)) + (-> m (assoc new (get m old)) (dissoc old)) m)) map kmap)) diff --git a/src/jvm/clojure/lang/APersistentMap.java b/src/jvm/clojure/lang/APersistentMap.java index 0fe08cae..d27dcb0f 100644 --- a/src/jvm/clojure/lang/APersistentMap.java +++ b/src/jvm/clojure/lang/APersistentMap.java @@ -1,375 +1,384 @@ -/**
- * 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.
- **/
-
-package clojure.lang;
-
-import java.io.Serializable;
-import java.util.*;
-
-public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable {
-int _hash = -1;
-
-public String toString(){
- return RT.printString(this);
-}
-
-public IPersistentCollection cons(Object o){
- if(o instanceof Map.Entry)
- {
- Map.Entry e = (Map.Entry) o;
-
- return assoc(e.getKey(), e.getValue());
- }
- else if(o instanceof IPersistentVector)
- {
- IPersistentVector v = (IPersistentVector) o;
- if(v.count() != 2)
- throw new IllegalArgumentException("Vector arg to map conj must be a pair");
- return assoc(v.nth(0), v.nth(1));
- }
-
- IPersistentMap ret = this;
- for(ISeq es = RT.seq(o); es != null; es = es.next())
- {
- Map.Entry e = (Map.Entry) es.first();
- ret = ret.assoc(e.getKey(), e.getValue());
- }
- return ret;
-}
-
-public boolean equals(Object obj){
- if(this == obj) return true;
- if(!(obj instanceof Map))
- return false;
- Map m = (Map) obj;
-
- if(m.size() != size() || m.hashCode() != hashCode())
- return false;
-
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- boolean found = m.containsKey(e.getKey());
-
- if(!found || !Util.equals(e.getValue(), m.get(e.getKey())))
- return false;
- }
-
- return true;
-}
-
-public boolean equiv(Object obj){
- if(!(obj instanceof Map))
- return false;
- Map m = (Map) obj;
-
- if(m.size() != size())
- return false;
-
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- boolean found = m.containsKey(e.getKey());
-
- if(!found || !Util.equiv(e.getValue(), m.get(e.getKey())))
- return false;
- }
-
- return true;
-}
-public int hashCode(){
- if(_hash == -1)
- {
- //int hash = count();
- int hash = 0;
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^
- (e.getValue() == null ? 0 : e.getValue().hashCode());
- //hash ^= Util.hashCombine(Util.hash(e.getKey()), Util.hash(e.getValue()));
- }
- this._hash = hash;
- }
- return _hash;
-}
-
-static public class KeySeq extends ASeq{
- ISeq seq;
-
- static public KeySeq create(ISeq seq){
- if(seq == null)
- return null;
- return new KeySeq(seq);
- }
-
- private KeySeq(ISeq seq){
- this.seq = seq;
- }
-
- private KeySeq(IPersistentMap meta, ISeq seq){
- super(meta);
- this.seq = seq;
- }
-
- public Object first(){
- return ((Map.Entry) seq.first()).getKey();
- }
-
- public ISeq next(){
- return create(seq.next());
- }
-
- public KeySeq withMeta(IPersistentMap meta){
- return new KeySeq(meta, seq);
- }
-}
-
-static public class ValSeq extends ASeq{
- ISeq seq;
-
- static public ValSeq create(ISeq seq){
- if(seq == null)
- return null;
- return new ValSeq(seq);
- }
-
- private ValSeq(ISeq seq){
- this.seq = seq;
- }
-
- private ValSeq(IPersistentMap meta, ISeq seq){
- super(meta);
- this.seq = seq;
- }
-
- public Object first(){
- return ((Map.Entry) seq.first()).getValue();
- }
-
- pu |