fnmap.clj: added new library; maps with custom implementations

3 files changed, 142 insertions, 0 deletions

diff --git a/src/clojure/contrib/fnmap.clj b/src/clojure/contrib/fnmap.clj
new file mode 100644
index 00000000..f9cfc7c5
--- /dev/null
+++ b/src/clojure/contrib/fnmap.clj
@@ -0,0 +1,36 @@
+;;; fnmap.clj: maps that dispatch get/assoc to functions
+
+;; Copyright (c) Stuart Sierra, 2008. 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 #^{:author "Stuart Sierra"
+       :doc "Maps that dispatch get/assoc to user-defined functions.
+
+  Note: requires AOT-compilation"}
+  clojure.contrib.fnmap
+  (:require clojure.contrib.fnmap.PersistentFnMap))
+
+(defn fnmap
+  "Creates a fnmap, or functional map.  A fnmap behaves like an
+  ordinary Clojure map, except that calls to get and assoc are
+  filtered through user-defined getter and setter functions, which
+  operate on an internal map.
+
+  (getter m key) should return a value for key.
+
+  (setter m key value) should assoc key with value and return a new
+  map for m.
+
+  All other map operations are passed through to the internal map."
+  ([getter setter] (clojure.contrib.fnmap.PersistentFnMap/create getter setter))
+  ([getter setter & keyvals]
+      (apply assoc
+             (clojure.contrib.fnmap.PersistentFnMap/create getter setter)
+             keyvals)))
+
diff --git a/src/clojure/contrib/fnmap/PersistentFnMap.clj b/src/clojure/contrib/fnmap/PersistentFnMap.clj
new file mode 100644
index 00000000..c340c74e
--- /dev/null
+++ b/src/clojure/contrib/fnmap/PersistentFnMap.clj
@@ -0,0 +1,67 @@
+;; PersistentFnMap.clj: implementation for clojure.contrib.fnmap
+
+;; Copyright (c) Stuart Sierra, 2009. 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.
+
+
+;; Thanks to Meikel Brandmeyer for his work on lazymap, which made
+;; this implementation easier.
+
+
+(ns clojure.contrib.fnmap.PersistentFnMap
+  (:gen-class :extends clojure.lang.APersistentMap
+              :state state
+              :init init
+              :constructors {[clojure.lang.IPersistentMap] [],
+                             [clojure.lang.IPersistentMap clojure.lang.IPersistentMap] [clojure.lang.IPersistentMap]}))
+
+(defn -init
+  ([theMap] [[] theMap])
+  ([theMap metadata] [[metadata] theMap]))
+
+(defn create [getter setter]
+  (clojure.contrib.fnmap.PersistentFnMap.
+   {::getter getter ::setter setter}))
+
+;; IPersistentMap
+
+(defn -assoc [this key value]
+  (clojure.contrib.fnmap.PersistentFnMap.
+   ((::setter (. this state)) (. this state) key value)))
+
+;; Associative
+
+(defn- -containsKey [this key]
+  (not (nil? ((::getter (. this state)) this key))))
+
+(defn- -entryAt [this key]
+  (clojure.lang.MapEntry. key ((::getter (. this state)) (. this state) key)))
+
+
+(defn -valAt [this key]
+  ((::getter (. this state)) (. this state) key))
+
+;; Iterable
+
+(defn -iterator [this]
+  (.. this state iterator))
+
+;; IPersistentCollection
+
+(defn -count [this]
+  (count (. this state)))
+
+(defn -seq [this]
+  (seq (. this state)))
+
+(defn -cons [this that]
+  (.. this state (cons this that)))
+
+(defn -empty [this]
+  (.. this state empty))
+
diff --git a/src/clojure/contrib/test_contrib/fnmap.clj b/src/clojure/contrib/test_contrib/fnmap.clj
new file mode 100644
index 00000000..ccd7a54a
--- /dev/null
+++ b/src/clojure/contrib/test_contrib/fnmap.clj
@@ -0,0 +1,39 @@
+(ns clojure.contrib.test-contrib.fnmap
+  (:use clojure.contrib.fnmap
+        clojure.contrib.test-is))
+
+(deftest acts-like-map
+  (let [m1 (fnmap get assoc :key1 1 :key2 2)]
+    (are (= _2 (get m1 _1))
+         :key1 1
+         :key2 2
+         :nonexistent-key nil)
+    (are (= _2 (_1 m1))
+         :key1 1
+         :key2 2
+         :nonexistent-key nil)
+    (let [m2 (assoc m1 :key3 3 :key4 4)]
+      (are (= _2 (get m2 _1))
+           :key1 1
+           :key2 2
+           :key3 3
+           :key4 4
+           :nonexistent-key nil))))
+
+(defn assoc-validate [m key value]
+  (if (integer? value)
+    (assoc m key value)
+    (throw (Exception. "Only integers allowed in this map!"))))
+
+(deftest validators
+  (let [m (fnmap get assoc-validate)]
+    (is (= 2 (:key2 (assoc m :key2 2))))
+    (is (thrown? Exception (assoc m :key3 3.14)))))
+
+(defn get-transform [m key]
+  (when-let [value (m key)]
+    (- value)))
+
+(deftest transforms
+  (let [m (fnmap get-transform assoc)]
+    (is (= -2 (:key2 (assoc m :key2 2))))))