Source

lazymap / lazy-map.clj

Full commit
;-
; Copyright 2008 (c) Meikel Brandmeyer.
; All rights reserved.
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE.

(clojure/in-ns 'lazy-map)
(clojure/refer 'clojure)

(defn- every-nth [l n]
  (loop [l l
         r []]
    (if (< (count l) n)
      (conj r (first l))
      (recur (nthrest l n) (conj r (first l))))))

(defn- make-lazy-map [lm em]
  (let [lmap (ref lm)
        emap (ref em)]
    (fn
      ; Ugly Hack, but this is needed. Unfortunately. For internal purposes only.
      ([] [@lmap @emap])
      ([k]
       (or (@emap k)
           (let [lv (@lmap k)]
             (when-not (nil? lv)
               (let [lve (lv)]
                 (dosync
                   (commute emap assoc k lve)
                   ; We dissoc the old value here to prevent a space leak.
                   (commute lmap dissoc k))
                 lve))))))))

(defn lazy-assoc* [lm & kvs]
  (let [[lm em] (lm)
        lmap    (apply assoc lm kvs)
        emap    (apply dissoc em (every-nth kvs 2))]
    (make-lazy-map lmap emap)))

(defn lazy-map* [& kvs]
  (apply lazy-assoc* (fn [] [{} {}]) kvs))

(defn- quote-values [kvs]
  (loop [[k v & r :as kvs] kvs
         qkvs              []]
    (if (nil? kvs)
      qkvs
      (recur r (conj (conj qkvs k) `(fn [] ~v))))))

(defmacro lazy-assoc
  "Lazy-assoc associates new values to the given keys in the given lazy map.
  The values are not evaluated, before their first retrieval. They are evaluated
  at most once."
  [lm & kvs]
  `(apply lazy-assoc* ~lm ~(quote-values kvs)))

(defmacro lazy-map
  "Lazy-map creates a map and returns a closure as function over the map's
  keys. Each value is evaluated at most once."
  [& kvs]
  `(apply lazy-map* ~(quote-values kvs)))

(defn lazy-dissoc
  "Lazy-dissoc dissociates the given key from the given lazy map."
  [lm & ks]
  (let [[lmap emap] (lm)]
    (make-lazy-map (apply dissoc lmap ks) (apply dissoc emap ks))))