Permalink
Browse files

make a protocol for key lookup, rather than polluting the namespace

  • Loading branch information...
ztellman committed Dec 28, 2011
1 parent 86452e5 commit 2d2d7f02175294e31edff9df1dd2ad8a9713da9b
Showing with 162 additions and 149 deletions.
  1. +1 −1 .gitignore
  2. +143 −146 src/potemkin/map.clj
  3. +14 −0 src/potemkin/protocols.clj
  4. +4 −2 test/potemkin/test/map.clj
View
@@ -2,4 +2,4 @@ pom.xml
*jar
lib
classes
-.lein-failures
+.lein*
View
@@ -7,7 +7,9 @@
;; You must not remove this notice, or any other, from this software.
(ns potemkin.map
- (:use [clojure.walk])
+ (:use
+ [clojure.walk]
+ [potemkin protocols])
(:import
java.util.Map$Entry
clojure.lang.MapEntry
@@ -43,154 +45,149 @@
throw-arity (fn [actual]
`(throw
(RuntimeException.
- ~(str "Wrong number of args (" actual ") passed to: " name))))
- data-sym (gensym "data")
- this-sym (gensym "this")
- keys-sym (gensym (str name "-keys"))]
+ ~(str "Wrong number of args (" actual ") passed to: " name))))]
(postwalk strip-namespaces
- `(do
- (def ~keys-sym
+ `(deftype ~name [data ~@args]
+ clojure.lang.MapEquivalence
+ clojure.lang.IPersistentCollection
+ potemkin.protocols.PotemkinMap
+ (keys* [this data]
~(if-not keys-generator
- `(fn [~data-sym ~'_]
- (keys ~data-sym))
- `(fn [~data-sym ~this-sym]
- ~((eval keys-generator) name data-sym this-sym))))
- (deftype ~name [data ~@args]
- clojure.lang.MapEquivalence
- clojure.lang.IPersistentCollection
- (equiv [this x]
+ `(keys ~'data)
+ `~((eval keys-generator) name 'data 'this)))
+ (equiv [this x]
+ (and
+ (map? x)
+ (= x (into {} this))))
+ (cons [this o]
+ (cond
+ (instance? Map$Entry o)
+ (let [[a b] o]
+ (assoc this a b))
+ (instance? IPersistentVector o)
+ (do
+ (assert (= 2 (count o)))
+ (let [[a b] o]
+ (assoc this a b)))
+ :else
+ (reduce conj this o)))
+ clojure.lang.Counted
+ (count [this]
+ (count (potemkin.protocols/keys* this ~unwrapped-data)))
+ clojure.lang.Seqable
+ (seq [this]
+ (map #(MapEntry. % (.valAt this % nil)) (potemkin.protocols/keys* this ~unwrapped-data)))
+ Object
+ (equals [this x]
+ (or (identical? this x)
(and
(map? x)
- (= x (into {} this))))
- (cons [this o]
- (cond
- (instance? Map$Entry o)
- (let [[a b] o]
- (assoc this a b))
- (instance? IPersistentVector o)
- (do
- (assert (= 2 (count o)))
- (let [[a b] o]
- (assoc this a b)))
- :else
- (reduce conj this o)))
- clojure.lang.Counted
- (count [this]
- (count (~keys-sym ~unwrapped-data this)))
- clojure.lang.Seqable
- (seq [this]
- (map #(MapEntry. % (.valAt this % nil)) (~keys-sym ~unwrapped-data this)))
- Object
- (equals [this x]
- (or (identical? this x)
- (and
- (map? x)
- (= x (into {} this)))))
- (toString [this]
- (str (into {} this)))
- clojure.lang.ILookup
- (valAt [this k]
- (.valAt this k nil))
- (valAt [this k default]
- ~(if get-generator
- ((eval get-generator) name 'data 'this 'k 'default)
- `(get ~unwrapped-data k default)))
- clojure.lang.Associative
- (containsKey [_ k]
- (contains? ~unwrapped-data k))
- (entryAt [this k]
- (let [v (.valAt this k nil)]
- (reify java.util.Map$Entry
- (getKey [_] k)
- (getValue [_] v))))
- (assoc [this k v]
- ~(if assoc-generator
- ((eval assoc-generator) name 'data 'this 'k 'v)
- `(new ~name ~(wrapped-data `(assoc ~unwrapped-data k v)) ~@args)))
- java.util.Map
- (get [this k]
- (.valAt this k))
- (isEmpty [this]
- (empty? this))
- (size [this]
- (count this))
- (keySet [this]
- (set (~keys-sym ~unwrapped-data this)))
- (put [_ _ _]
- (throw (UnsupportedOperationException.)))
- (putAll [_ _]
- (throw (UnsupportedOperationException.)))
- (clear [_]
- (throw (UnsupportedOperationException.)))
- (remove [_ _]
- (throw (UnsupportedOperationException.)))
- (values [this]
- (->> this seq (map second)))
- (entrySet [this]
- (->> this seq set))
- clojure.lang.IPersistentMap
- (assocEx [this k v]
- (if (contains? ~unwrapped-data k)
- (throw (Exception. "Key or value already present"))
- (assoc this k v)))
- (without [this k]
- ~(if dissoc-generator
- ((eval dissoc-generator) name 'data 'this 'k)
- `(new ~name ~(wrapped-data `(dissoc ~unwrapped-data k)) ~@args)))
- java.util.concurrent.Callable
- (call [this]
- ~(throw-arity 0))
- java.lang.Runnable
- (run [this]
- ~(throw-arity 0))
- clojure.lang.IFn
- (invoke [this]
- ~(throw-arity 0))
- (invoke [this k]
- (.valAt this k))
- (invoke [this k not-found]
- (.valAt this k not-found))
- (invoke [this a1 a2 a3]
- ~(throw-arity 3))
- (invoke [this a1 a2 a3 a4]
- ~(throw-arity 4))
- (invoke [this a1 a2 a3 a4 a5]
- ~(throw-arity 5))
- (invoke [this a1 a2 a3 a4 a5 a6]
- ~(throw-arity 6))
- (invoke [this a1 a2 a3 a4 a5 a6 a7]
- ~(throw-arity 7))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8]
- ~(throw-arity 8))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9]
- ~(throw-arity 9))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10]
- ~(throw-arity 10))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11]
- ~(throw-arity 11))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12]
- ~(throw-arity 12))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13]
- ~(throw-arity 13))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14]
- ~(throw-arity 14))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15]
- ~(throw-arity 15))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16]
- ~(throw-arity 16))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17]
- ~(throw-arity 17))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18]
- ~(throw-arity 18))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19]
- ~(throw-arity 19))
- (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20]
- ~(throw-arity 20))
- (applyTo [this args]
- (case (count args)
- 1 (.invoke this (first args))
- 2 (.invoke this (first args) (second args))
- ~(throw-arity (count args))))))
+ (= x (into {} this)))))
+ (toString [this]
+ (str (into {} this)))
+ clojure.lang.ILookup
+ (valAt [this k]
+ (.valAt this k nil))
+ (valAt [this k default]
+ ~(if get-generator
+ ((eval get-generator) name 'data 'this 'k 'default)
+ `(get ~unwrapped-data k default)))
+ clojure.lang.Associative
+ (containsKey [this k]
+ (contains? (.keySet this) k))
+ (entryAt [this k]
+ (let [v (.valAt this k nil)]
+ (reify java.util.Map$Entry
+ (getKey [_] k)
+ (getValue [_] v))))
+ (assoc [this k v]
+ ~(if assoc-generator
+ ((eval assoc-generator) name 'data 'this 'k 'v)
+ `(new ~name ~(wrapped-data `(assoc ~unwrapped-data k v)) ~@args)))
+ java.util.Map
+ (get [this k]
+ (.valAt this k))
+ (isEmpty [this]
+ (empty? this))
+ (size [this]
+ (count this))
+ (keySet [this]
+ (set (potemkin.protocols/keys* this ~unwrapped-data)))
+ (put [_ _ _]
+ (throw (UnsupportedOperationException.)))
+ (putAll [_ _]
+ (throw (UnsupportedOperationException.)))
+ (clear [_]
+ (throw (UnsupportedOperationException.)))
+ (remove [_ _]
+ (throw (UnsupportedOperationException.)))
+ (values [this]
+ (->> this seq (map second)))
+ (entrySet [this]
+ (->> this seq set))
+ clojure.lang.IPersistentMap
+ (assocEx [this k v]
+ (if (contains? ~unwrapped-data k)
+ (throw (Exception. "Key or value already present"))
+ (assoc this k v)))
+ (without [this k]
+ ~(if dissoc-generator
+ ((eval dissoc-generator) name 'data 'this 'k)
+ `(new ~name ~(wrapped-data `(dissoc ~unwrapped-data k)) ~@args)))
+ java.util.concurrent.Callable
+ (call [this]
+ ~(throw-arity 0))
+ java.lang.Runnable
+ (run [this]
+ ~(throw-arity 0))
+ clojure.lang.IFn
+ (invoke [this]
+ ~(throw-arity 0))
+ (invoke [this k]
+ (.valAt this k))
+ (invoke [this k not-found]
+ (.valAt this k not-found))
+ (invoke [this a1 a2 a3]
+ ~(throw-arity 3))
+ (invoke [this a1 a2 a3 a4]
+ ~(throw-arity 4))
+ (invoke [this a1 a2 a3 a4 a5]
+ ~(throw-arity 5))
+ (invoke [this a1 a2 a3 a4 a5 a6]
+ ~(throw-arity 6))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7]
+ ~(throw-arity 7))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8]
+ ~(throw-arity 8))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9]
+ ~(throw-arity 9))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10]
+ ~(throw-arity 10))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11]
+ ~(throw-arity 11))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12]
+ ~(throw-arity 12))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13]
+ ~(throw-arity 13))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14]
+ ~(throw-arity 14))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15]
+ ~(throw-arity 15))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16]
+ ~(throw-arity 16))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17]
+ ~(throw-arity 17))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18]
+ ~(throw-arity 18))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19]
+ ~(throw-arity 19))
+ (invoke [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20]
+ ~(throw-arity 20))
+ (applyTo [this args]
+ (case (count args)
+ 1 (.invoke this (first args))
+ 2 (.invoke this (first args) (second args))
+ ~(throw-arity (count args)))))
))))
(defmacro def-custom-map
@@ -220,7 +217,7 @@
`(if-not (contains? ~data ~key)
~default-value
(let [val# (get ~data ~key)]
- (if (instance? clojure.lang.IDeref val#)
+ (if (delay? val#)
@val#
val#)))))
View
@@ -0,0 +1,14 @@
+;; Copyright (c) Zachary Tellman. 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.
+
+(ns potemkin.protocols)
+
+(defprotocol PotemkinMap
+ (keys* [this data]))
+
+
@@ -9,7 +9,7 @@
(ns potemkin.test.map
(:use
[clojure test]
- [potemkin map]))
+ [potemkin]))
(def-custom-map SimpleMap)
@@ -31,7 +31,9 @@
(is (= 1 (get m :a)))
(is (= 2 (get m :b 2)))
(is (= 1 (:a m)))
- (is (= 1 (m :a))))
+ (is (= 1 (m :a)))
+ (is (= [:a] (keys m)))
+ (is (= [[:a 1]] (seq m))))
(let [m (-> m (assoc :a 1) (dissoc :a))]
(is (not (contains? m :a))))
(let [s (-> m (assoc :a 1) seq)]

0 comments on commit 2d2d7f0

Please sign in to comment.