mutable.clj

(def mutable-type-cache (atom {}))

(defmacro mutable [m]
  (let [sorted-keys (sort (keys m))
        names (sort (map name sorted-keys))
        types (map type (map #(eval (get m %)) sorted-keys))
        signature (interleave names types)
        munged-signature (interleave (repeat "$") names
                                     (repeat "$") types)
        cached-name (@mutable-type-cache signature)
        type-name (gensym (string/replace (apply str "mutable$" signature) #"\." "$"))
        full-type-name (or cached-name
                           (symbol (str *ns* "." type-name)))
        map-ctor-name (symbol (str "map->" type-name))
        ctor-param (gensym "hm")
        this-sym (gensym "this")
        dict-param (gensym "dict")]
    (if cached-name
      `(new ~full-type-name
            ~@(map
                (fn [n]
                  `(get ~m ~(keyword n)))
                names))
      (do 
        (swap! mutable-type-cache assoc signature full-type-name)
        `(do
           (deftype
             ~type-name
             ~(mapv (fn [name type]
                      (with-meta (symbol name) {:tag (symbol (.FullName type)) :unsynchronized-mutable true}))
                    names
                    types))
           (defmethod print-method ~full-type-name [~this-sym ^System.IO.TextWriter stream#]
             (let [datamap# (hash-map
                              ~@(mapcat
                                  (fn [n]
                                    [(keyword n) `(. ~this-sym ~(symbol n))])
                                  names))]
               (.Write stream#
                       (str "#mutable " #_ ~full-type-name  (pr-str datamap#)))))
           (Activator/CreateInstance
             (resolve '~full-type-name)
             (into-array
               Object
               ~(mapv
                  (fn [n]
                    `(get ~m ~(keyword n)))
                  names))))))))