first cut of deftype/defrecord split

6 files changed, 223 insertions, 162 deletions

diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index c054d6e0..6266c691 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -15,8 +15,11 @@
   [name & sigs]
   (let [tag (fn [x] (or (:tag (meta x)) Object))
         psig (fn [[name [& args]]]
-               (vector name (vec (map tag args)) (tag name)))]
-    `(gen-interface :name ~(symbol (str *ns* "." name)) :methods ~(vec (map psig sigs)))))
+               (vector name (vec (map tag args)) (tag name)))
+        cname (symbol (str *ns* "." name))]
+    `(do (gen-interface :name ~cname :methods ~(vec (map psig sigs)))
+         (ns-unmap (find-ns '~(ns-name *ns*)) '~name)
+         (import ~cname))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -104,8 +107,8 @@
 (defn munge [s]
   ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))
 
-(defn- emit-deftype* 
-  "Do not use this directly - use deftype"
+(defn- emit-defrecord 
+  "Do not use this directly - use defrecord"
   [tagname name fields interfaces methods]
   (let [tag (keyword (str *ns*) (str tagname))
         classname (symbol (str *ns* "." name))
@@ -118,95 +121,77 @@
         fields (vec (map #(with-meta % nil) fields))
         base-fields fields
         fields (conj fields '__meta '__extmap)]
+    (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields))
+      (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
     (letfn 
      [(eqhash [[i m]] 
-        (if (not (or (contains? methodname-set 'equals) (contains? methodname-set 'hashCode)))
-          [i
-           (conj m 
-                 `(hashCode [~'this] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields))))
-                 `(equals [~'this ~'o] 
-                    (boolean 
-                     (or (identical? ~'this ~'o)
-                         (when (instance? clojure.lang.IDynamicType ~'o)
-                           (let [~'o ~(with-meta 'o {:tag 'clojure.lang.IDynamicType})]
-                             (and (= ~tag (.getDynamicType ~'o)) 
-                                  ~@(map (fn [fld] `(= ~fld (.getDynamicField ~'o ~(keyword fld) ~'this))) base-fields)
-                                  (= ~'__extmap (.getExtensionMap ~'o)))))))))]
-          [i m]))
+        [i
+         (conj m 
+               `(hashCode [~'this] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields))))
+               `(equals [~'this ~'o] 
+                        (boolean 
+                         (or (identical? ~'this ~'o)
+                             (when (identical? (class ~'this) (class ~'o))
+                               (let [~'o ~(with-meta 'o {:tag tagname})]
+                                 (and  ~@(map (fn [fld] `(= ~fld (. ~'o ~fld))) base-fields)
+                                       (= ~'__extmap (. ~'o ~'__extmap)))))))))])
       (iobj [[i m]] 
-        (if (and (implement? clojure.lang.IObj) (implement? clojure.lang.IMeta))
-          [(conj i 'clojure.lang.IObj)
-           (conj m `(meta [~'this] ~'__meta)
-                 `(withMeta [~'this ~'m] (new ~tagname ~@(replace {'__meta 'm} fields))))]
-          [i m]))
+            [(conj i 'clojure.lang.IObj)
+             (conj m `(meta [~'this] ~'__meta)
+                   `(withMeta [~'this ~'m] (new ~tagname ~@(replace {'__meta 'm} fields))))])
       (ilookup [[i m]] 
-        (if (not (methodname-set 'valAt))
-          [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
-           (conj m `(valAt [~'this k#] (.valAt ~'this k# nil))
-                 `(valAt [~'this k# else#] 
-                    (case k# ~@(mapcat (fn [fld] [(keyword fld) fld]) 
-                                                   base-fields)
-                           (get ~'__extmap k# else#)))
-                 (let [gclass (gensym)] 
-                   `(getLookupThunk [~'this k#]
-                       (let [~gclass (class ~'this)]              
-                         (case k#
-                            ~@(let [gtarget (gensym) 
-                                    hinted-target (with-meta gtarget {:tag tagname})] 
-                                (mapcat 
-                                 (fn [fld]
-                                   [(keyword fld) 
-                                    `(reify clojure.lang.ILookupThunk 
-                                       (get [thunk# ~gtarget] 
-                                            (if (identical? (class ~gtarget) ~gclass) 
-                                              (. ~hinted-target ~fld)
-                                              thunk#)))])
-                                 base-fields))
-                            nil)))))]
-          [i m]))
-      (idynamictype [[i m]]
-        [(conj i 'clojure.lang.IDynamicType)
-         (conj m
-               `(getDynamicType [~'this] ~tag)
-               `(getExtensionMap [~'this] ~'__extmap)
-               `(getDynamicField [~'this k# else#] 
-                  (condp identical? k# ~@(mapcat (fn [fld] [(keyword fld) fld]) base-fields)
-                         (get ~'__extmap k# else#))))])
+         [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
+          (conj m `(valAt [~'this ~'k] (.valAt ~'this ~'k nil))
+                `(valAt [~'this ~'k ~'else] 
+                   (case ~'k ~@(mapcat (fn [fld] [(keyword fld) fld]) 
+                                       base-fields)
+                         (get ~'__extmap ~'k ~'else)))
+                `(getLookupThunk [~'this ~'k]
+                   (let [~'gclass (class ~'this)]              
+                     (case ~'k
+                           ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})] 
+                               (mapcat 
+                                (fn [fld]
+                                  [(keyword fld) 
+                                   `(reify clojure.lang.ILookupThunk 
+                                           (get [~'thunk ~'gtarget] 
+                                                (if (identical? (class ~'gtarget) ~'gclass) 
+                                                  (. ~hinted-target ~fld)
+                                                  ~'thunk)))])
+                                base-fields))
+                           nil))))])
       (imap [[i m]] 
-         (if (and (interface-set clojure.lang.IPersistentMap) (not (methodname-set 'assoc)))
-           [i
-            (conj m 
-                  `(count [~'this] (+ ~(count base-fields) (count ~'__extmap)))
-                  `(empty [~'this] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
-                  `(cons [~'this e#] (let [[k# v#] e#] (.assoc ~'this k# v#)))
-                  `(equiv [~'this o#] (.equals ~'this o#))
-                  `(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))
-                  (let [gk (gensym) gv (gensym)]
-                    `(assoc [~'this ~gk ~gv]
-                       (condp identical? ~gk
-                         ~@(mapcat (fn [fld]
-                                     [(keyword fld) (list* `new tagname (replace {fld gv} fields))])
-                                   base-fields)
-                         (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap ~gk ~gv)))))
-                  `(without [~'this k#] (if (contains? #{~@(map keyword base-fields)} k#)
-                                     (dissoc (with-meta (into {} ~'this) ~'__meta) k#)
-                                     (new ~tagname ~@(remove #{'__extmap} fields) 
-                                          (not-empty (dissoc ~'__extmap k#))))))]
-           [i m]))]
-     (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap idynamictype)]
+            [(conj i 'clojure.lang.IPersistentMap)
+             (conj m 
+                   `(count [~'this] (+ ~(count base-fields) (count ~'__extmap)))
+                   `(empty [~'this] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
+                   `(cons [~'this ~'e] (let [[~'k ~'v] ~'e] (.assoc ~'this ~'k ~'v)))
+                   `(equiv [~'this ~'o] (.equals ~'this ~'o))
+                   `(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))
+                   `(assoc [~'this ~'gk__4242 ~'gv__4242]
+                     (condp identical? ~'gk__4242
+                       ~@(mapcat (fn [fld]
+                                   [(keyword fld) (list* `new tagname (replace {fld 'gv__4242} fields))])
+                                 base-fields)
+                       (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap ~'gk__4242 ~'gv__4242))))
+                   `(without [~'this ~'k] (if (contains? #{~@(map keyword base-fields)} ~'k)
+                                            (dissoc (with-meta (into {} ~'this) ~'__meta) ~'k)
+                                            (new ~tagname ~@(remove #{'__extmap} fields) 
+                                                 (not-empty (dissoc ~'__extmap ~'k))))))])]
+     (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap)]
        `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) 
           :implements ~(vec i) 
           ~@m)))))
 
-(defmacro deftype
+(defmacro defrecord
   "Alpha - subject to change
   
-  (deftype name [fields*]  options* specs*)
+  (defrecord name [fields*]  options* specs*)
   
   Currently there are no options.
 
@@ -216,11 +201,10 @@
   protocol-or-interface-or-Object
   (methodName [args*] body)*
 
-  Dynamically generates compiled bytecode for an anonymous class with
-  the given fields, and, optionally, methods for protocols and/or
-  interfaces. The Name will be used to create a dynamic type tag
-  keyword of the form :current.ns/Name. This tag will be returned
-  from (type an-instance).
+  Dynamically generates compiled bytecode for class with the given
+  name, in a package with the same name as the current namespace, the
+  given fields, and, optionally, methods for protocols and/or
+  interfaces.
 
   A factory function of current.ns/Name will be defined,
   overloaded on 2 arities, the first taking the designated fields in
@@ -228,20 +212,12 @@
   by a metadata map (nil for none) and an extension field map (nil for
   none). 
 
-  The class will have the (by default, immutable) fields named by
+  The class will have the (immutable) fields named by
   fields, which can have type hints. Protocols/interfaces and methods
   are optional. The only methods that can be supplied are those
   declared in the protocols/interfaces.  Note that method bodies are
   not closures, the local environment includes only the named fields,
-  and those fields can be accessed directy. Fields can be qualified
-  with the metadata :volatile-mutable true or :unsynchronized-mutable
-  true, at which point (set! afield aval) will be supported in method
-  bodies. Note well that mutable fields are extremely difficult to use
-  correctly, and are present only to facilitate the building of higher
-  level constructs, such as Clojure's reference types, in Clojure
-  itself. They are for experts only - if the semantics and
-  implications of :volatile-mutable or :unsynchronized-mutable are not
-  immediately apparent to you, you should not be using them.
+  and those fields can be accessed directy.
 
   Method definitions take the form:
 
@@ -263,14 +239,11 @@
   In the method bodies, the (unqualified) name can be used to name the
   class (for calls to new, instance? etc).
 
-  The class will have implementations of two (clojure.lang) interfaces
-  generated automatically: IObj (metadata support), ILookup (get and
-  keyword lookup for fields). If you specify IPersistentMap as an
-  interface, but don't define methods for it, an implementation will
-  be generated automatically.
+  The class will have implementations of several (clojure.lang)
+  interfaces generated automatically: IObj (metadata support) and
+  IPersistentMap, and all of their superinterfaces.
 
-  In addition, unless you supply a version of hashCode or equals,
-  deftype/class will define type-and-value-based equality and
+  In addition, defrecord will define type-and-value-based equality and
   hashCode.
 
   When AOT compiling, generates compiled bytecode for a class with the
@@ -280,35 +253,114 @@
   Two constructors will be defined, one taking the designated fields
   followed by a metadata map (nil for none) and an extension field
   map (nil for none), and one taking only the fields (using nil for
-  meta and extension fields).
-
-  When dynamically evaluated, the class will have a generated name."
+  meta and extension fields)."
 
   [name [& fields] & opts+specs]
-  (let [gname (if *compile-files* name (gensym (str name "__")))
+  (let [gname name
         [interfaces methods opts] (parse-opts+specs opts+specs)
         classname (symbol (str *ns* "." gname))
         tag (keyword (str *ns*) (str name))
         hinted-fields fields
         fields (vec (map #(with-meta % nil) fields))]
     `(do
-       ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
-       (defmethod print-method ~tag [o# w#]
-         ((var print-deftype) ~(vec (map #(-> % str keyword) fields)) o# w#))
-       (defn ~name
+       ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
+       (defmethod print-method ~classname [o# w#]
+           ((var print-defrecord) o# w#))
+       (ns-unmap (find-ns '~(ns-name *ns*)) '~name)
+       (import ~classname)
+       #_(defn ~name
          ([~@fields] (new ~classname ~@fields nil nil))
          ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))))))
 
-(defn- print-deftype [fields, #^clojure.lang.IDynamicType o, #^Writer w]
+(defn- print-defrecord [o #^Writer w]
   (print-meta o w)
   (.write w "#:")
-  (.write w (str (name (.getDynamicType o))))
+  (.write w (.getName (class o)))
   (print-map
-    (concat
-      (map #(clojure.lang.MapEntry. % (.getDynamicField o % nil)) fields)
-      (.getExtensionMap o))
+    o
     pr-on w))
 
+(defn- emit-deftype* 
+  "Do not use this directly - use deftype"
+  [tagname name fields interfaces methods]
+  (let [classname (symbol (str *ns* "." name))]
+    `(deftype* ~tagname ~classname ~fields 
+       :implements ~interfaces 
+       ~@methods)))
+
+(defmacro deftype
+  "Alpha - subject to change
+  
+  (deftype name [fields*]  options* specs*)
+  
+  Currently there are no options.
+
+  Each spec consists of a protocol or interface name followed by zero
+  or more method bodies:
+
+  protocol-or-interface-or-Object
+  (methodName [args*] body)*
+
+  Dynamically generates compiled bytecode for class with the given
+  name, in a package with the same name as the current namespace, the
+  given fields, and, optionally, methods for protocols and/or
+  interfaces. 
+
+  The class will have the (by default, immutable) fields named by
+  fields, which can have type hints. Protocols/interfaces and methods
+  are optional. The only methods that can be supplied are those
+  declared in the protocols/interfaces.  Note that method bodies are
+  not closures, the local environment includes only the named fields,
+  and those fields can be accessed directy. Fields can be qualified
+  with the metadata :volatile-mutable true or :unsynchronized-mutable
+  true, at which point (set! afield aval) will be supported in method
+  bodies. Note well that mutable fields are extremely difficult to use
+  correctly, and are present only to facilitate the building of higher
+  level constructs, such as Clojure's reference types, in Clojure
+  itself. They are for experts only - if the semantics and
+  implications of :volatile-mutable or :unsynchronized-mutable are not
+  immediately apparent to you, you should not be using them.
+
+  Method definitions take the form:
+
+  (methodname [args*] body)
+
+  The argument and return types can be hinted on the arg and
+  methodname symbols. If not supplied, they will be inferred, so type
+  hints should be reserved for disambiguation.
+
+  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
+  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
+  head should *not* pass the target object, it will be supplied
+  automatically and can not be substituted.
+
+  In the method bodies, the (unqualified) name can be used to name the
+  class (for calls to new, instance? etc).
+
+  When AOT compiling, generates compiled bytecode for a class with the
+  given name (a symbol), prepends the current ns as the package, and
+  writes the .class file to the *compile-path* directory.
+
+  One constructors will be defined, taking the designated fields."
+
+  [name [& fields] & opts+specs]
+  (let [gname name ;(if *compile-files* name (gensym (str name "__")))
+        [interfaces methods opts] (parse-opts+specs opts+specs)
+        classname (symbol (str *ns* "." gname))
+        tag (keyword (str *ns*) (str name))
+        hinted-fields fields
+        fields (vec (map #(with-meta % nil) fields))]
+    `(do
+       ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
+       (ns-unmap (find-ns '~(ns-name *ns*)) '~name)
+       (import ~classname))))
+
+
+
 
 ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/src/clj/clojure/core_proxy.clj b/src/clj/clojure/core_proxy.clj
index c24b69d5..9cbc39a6 100644
--- a/src/clj/clojure/core_proxy.clj
+++ b/src/clj/clojure/core_proxy.clj
@@ -258,7 +258,7 @@
           pname (proxy-name super interfaces)]
       (or (RT/loadClassForName pname)
           (let [[cname bytecode] (generate-proxy super interfaces)]
-            (. #^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode))))))
+            (. #^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode [super interfaces]))))))
 
 (defn construct-proxy
   "Takes a proxy class and any arguments for its superclass ctor and
diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj
index 388efc0a..852314ef 100644
--- a/src/clj/clojure/genclass.clj
+++ b/src/clj/clojure/genclass.clj
@@ -666,7 +666,7 @@
       (if *compile-files*
         (clojure.lang.Compiler/writeClassFile cname bytecode)
         (.defineClass #^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) 
-                      (str (:name options-map)) bytecode)))) 
+                      (str (:name options-map)) bytecode options)))) 
 
 (comment
 
@@ -681,6 +681,6 @@
   [& options]
   (let [options-map (apply hash-map options)
         [cname bytecode] (generate-class options-map)]
-    (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode))))
+    (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode options))))
 
 )
diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj
index f00de920..a47959b0 100644
--- a/src/clj/clojure/gvec.clj
+++ b/src/clj/clojure/gvec.clj
@@ -14,7 +14,7 @@
 
 (deftype VecNode [edit arr])
 
-(def EMPTY-NODE (VecNode nil (object-array 32)))
+(def EMPTY-NODE (VecNode. nil (object-array 32)))
 
 (definterface IVecImpl
   (#^int tailoff [])
@@ -68,7 +68,7 @@
   (seq [this] this)
 
   clojure.lang.IChunkedSeq
-  (chunkedFirst [_] (ArrayChunk am anode offset (.alength am anode)))
+  (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode)))
   (chunkedNext [_] 
    (let [nexti (+ i (.alength am anode))]
      (when (< nexti (count vec))
@@ -80,9 +80,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]
-  :no-print true
-
+(deftype Vec [#^clojure.core.ArrayManager am #^int cnt #^int shift root tail _meta]
   Object
   (equals [this o]
     (cond 
@@ -110,6 +108,12 @@
   clojure.lang.Counted
   (count [_] cnt)
 
+  clojure.lang.IMeta
+  (meta [_] _meta)
+
+  clojure.lang.IObj
+  (withMeta [_ m] (new Vec am cnt shift root tail m))
+
   clojure.lang.Indexed
   (nth [this i]
     (let [a (.arrayFor this i)]
@@ -126,18 +130,18 @@
       (let [new-tail (.array am (inc (.alength am tail)))]
         (System/arraycopy tail 0 new-tail 0 (.alength am tail))
         (.aset am new-tail (.alength am tail) val)
-        (new Vec am (inc cnt) shift root new-tail (meta this) nil))
-      (let [tail-node (VecNode (:edit root) tail)] 
+        (new Vec am (inc cnt) shift root new-tail (meta this)))
+      (let [tail-node (VecNode. (:edit root) tail)] 
         (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root?
-          (let [new-root (VecNode (:edit root) (object-array 32))]
+          (let [new-root (VecNode. (:edit root) (object-array 32))]
             (doto #^objects (:arr new-root)
               (aset 0 root)
               (aset 1 (.newPath this (:edit root) shift tail-node)))
-            (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this) nil))
+            (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this)))
           (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) 
-                 (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this) nil)))))
+                 (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this))))))
 
-  (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0)))                             
+  (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil))                             
   (equiv [this o]
     (cond 
      (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o))
@@ -161,21 +165,21 @@
     (zero? cnt) 
       (throw (IllegalStateException. "Can't pop empty vector"))
     (= 1 cnt) 
-      (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this) nil)
+      (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this))
     (> (- cnt (.tailoff this)) 1)
       (let [new-tail (.array am (dec (.alength am tail)))]
         (System/arraycopy tail 0 new-tail 0 (.alength am new-tail))
-        (new Vec am (dec cnt) shift root new-tail (meta this) nil))
+        (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)]
         (cond
          (nil? new-root) 
-           (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this) nil)
+           (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this))
          (and (> shift 5) (nil? (aget #^objects (:arr new-root) 1)))
-           (new Vec am (dec cnt) (- shift 5) (aget #^objects (:arr new-root) 0) new-tail (meta this) nil)
+           (new Vec am (dec cnt) (- shift 5) (aget #^objects (:arr new-root) 0) new-tail (meta this))
          :else
-           (new Vec am (dec cnt) shift new-root new-tail (meta this) nil)))))
+           (new Vec am (dec cnt) shift new-root new-tail (meta this))))))
 
   clojure.lang.IPersistentVector
   (assocN [this i val]
@@ -185,8 +189,8 @@
          (let [new-tail (.array am (.alength am tail))]
            (System/arraycopy tail 0 new-tail 0 (.alength am tail))
            (.aset am new-tail (bit-and i (int 0x1f)) val)
-           (new Vec am cnt shift root new-tail (meta this) nil))
-         (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this) nil))
+           (new Vec am cnt shift root new-tail (meta this)))
+         (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this)))
      (= i cnt) (.cons this val)
      :else (throw (IndexOutOfBoundsException.))))
 
@@ -221,7 +225,7 @@
   (seq [this] 
     (if (zero? cnt) 
       nil
-      (VecSeq am this (.arrayFor this 0) 0 0)))
+      (VecSeq. am this (.arrayFor this 0) 0 0)))
 
   clojure.lang.Sequential ;marker, no methods
 
@@ -242,7 +246,7 @@
 
   (pushTail [this level parent tailnode]
     (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f))
-          ret (VecNode (:edit parent) (aclone #^objects (:arr parent)))
+          ret (VecNode. (:edit parent) (aclone #^objects (:arr parent)))
           node-to-insert (if (= level (int 5))
                            tailnode
                            (let [child (aget #^objects (:arr parent) subidx)]
@@ -261,16 +265,16 @@
              nil
              (let [arr (aclone #^objects (:arr node))]
                (aset arr subidx new-child)
-               (VecNode (:edit root) arr))))
+               (VecNode. (:edit root) arr))))
        (zero? subidx) nil
        :else (let [arr (aclone #^objects (:arr node))]
                (aset arr subidx nil)
-               (VecNode (:edit root) arr)))))
+               (VecNode. (:edit root) arr)))))
 
   (newPath [this edit #^int level node]
     (if (zero? level)
       node
-      (let [ret (VecNode edit (object-array 32))]
+      (let [ret (VecNode. edit (object-array 32))]
         (aset #^objects (:arr ret) 0 (.newPath this edit (- level (int 5)) node))
         ret)))
 
@@ -279,11 +283,11 @@
       ;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))
+        (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))))
+        (VecNode. (:edit node) arr))))
 
   java.lang.Iterable
   (iterator [this]
@@ -377,4 +381,4 @@
   but stores the values unboxed internally."  
   [t]
   (let [am #^clojure.core.ArrayManager (ams t)]
-    (Vec am 0 5 EMPTY-NODE (.array am 0))))
+    (Vec. am 0 5 EMPTY-NODE (.array am 0) nil)))
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index c4f991d9..aea3b062 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -3106,6 +3106,7 @@ static public class FnExpr extends ObjExpr{
 	static Expr parse(C context, ISeq form, String name) throws Exception{
 		ISeq origForm = form;
 		FnExpr fn = new FnExpr(tagOf(form));
+		fn.src = form;
 		ObjMethod enclosingMethod = (ObjMethod) METHOD.deref();
 		if(((IMeta) form.first()).meta() != null)
 			{
@@ -3252,6 +3253,8 @@ static public class ObjExpr implements Expr{
 	IPersistentVector protocolCallsites;
 	IPersistentVector varCallsites;
 
+	Object src;
+
 	final static Method voidctor = Method.getMethod("void <init>()");
 
 	public final String name(){
@@ -3938,7 +3941,7 @@ static public class ObjExpr implements Expr{
 				else
 					{
 					loader = (DynamicClassLoader) LOADER.deref();
-					compiledClass = loader.defineClass(name, bytecode);
+					compiledClass = loader.defineClass(name, bytecode, src);
 					}
 				}
 			catch(Exception e)
@@ -5977,7 +5980,7 @@ static public class NewInstanceExpr extends ObjExpr{
 	}
 
 	static class DeftypeParser implements IParser{
-		public Expr parse(C context, Object frm) throws Exception{
+		public Expr parse(C context, final Object frm) throws Exception{
 			ISeq rform = (ISeq) frm;
 			//(deftype* tagname classname [fields] :implements [interfaces] :tag tagname methods*)
 			rform = RT.next(rform);
@@ -5994,8 +5997,9 @@ static public class NewInstanceExpr extends ObjExpr{
 				rform = rform.next().next();
 				}
 
-			return build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname,
-			             (Symbol) RT.get(opts,RT.TAG_KEY),rform);
+			ObjExpr ret = build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname,
+			             (Symbol) RT.get(opts,RT.TAG_KEY),rform, frm);
+			return ret;
 		}
 	}
 
@@ -6018,7 +6022,7 @@ static public class NewInstanceExpr extends ObjExpr{
 		rform = RT.next(rform);
 
 
-		Expr ret = build(interfaces, null, null, classname, classname, null, rform);
+		ObjExpr ret = build(interfaces, null, null, classname, classname, null, rform, frm);
 		if(frm instanceof IObj && ((IObj) frm).meta() != null)
 			return new MetaExpr(ret, (MapExpr) MapExpr
 					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta()));
@@ -6029,9 +6033,10 @@ static public class NewInstanceExpr extends ObjExpr{
 
 	static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym,
 	                     String tagName, String className,
-	                  Symbol typeTag, ISeq methodForms) throws Exception{
+	                  Symbol typeTag, ISeq methodForms, Object frm) throws Exception{
 		NewInstanceExpr ret = new NewInstanceExpr(null);
 
+		ret.src = frm;
 		ret.name = className;
 		ret.internalName = ret.name.replace('.', '/');
 		ret.objtype = Type.getObjectType(ret.internalName);
@@ -6080,7 +6085,7 @@ static public class NewInstanceExpr extends ObjExpr{
 		
 		String[] inames = interfaceNames(interfaces);
 
-		Class stub = compileStub(slashname(superClass),ret, inames);
+		Class stub = compileStub(slashname(superClass),ret, inames, frm);
 		Symbol thistag = Symbol.intern(null,stub.getName());
 
 		try
@@ -6140,7 +6145,7 @@ static public class NewInstanceExpr extends ObjExpr{
 	 * Use it as a type hint for this, and bind the simple name of the class to this stub (in resolve etc)
 	 * Unmunge the name (using a magic prefix) on any code gen for classes
 	 */
-	static Class compileStub(String superName, NewInstanceExpr ret, String[] interfaceNames){
+	static Class compileStub(String superName, NewInstanceExpr ret, String[] interfaceNames, Object frm){
 		ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS);
 		ClassVisitor cv = cw;
 		cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, COMPILE_STUB_PREFIX + "/" + ret.internalName,
@@ -6205,7 +6210,7 @@ static public class NewInstanceExpr extends ObjExpr{
 
 		byte[] bytecode = cw.toByteArray();
 		DynamicClassLoader loader = (DynamicClassLoader) LOADER.deref();
-		return loader.defineClass(COMPILE_STUB_PREFIX + "." + ret.name, bytecode);		
+		return loader.defineClass(COMPILE_STUB_PREFIX + "." + ret.name, bytecode, frm);
 	}
 
 	static String[] interfaceNames(IPersistentVector interfaces){
diff --git a/src/jvm/clojure/lang/DynamicClassLoader.java b/src/jvm/clojure/lang/DynamicClassLoader.java
index 2a7ce676..7c58244e 100644
--- a/src/jvm/clojure/lang/DynamicClassLoader.java
+++ b/src/jvm/clojure/lang/DynamicClassLoader.java
@@ -22,8 +22,8 @@ import java.lang.ref.WeakReference;
 
 public class DynamicClassLoader extends URLClassLoader{
 HashMap<Integer, Object[]> constantVals = new HashMap<Integer, Object[]>();
-static ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Integer> >classCache =
-        new ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Integer> >();
+static ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Object> >classCache =
+        new ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Object> >();
 
 static final URL[] EMPTY_URLS = new URL[]{};
 
@@ -38,22 +38,22 @@ public DynamicClassLoader(ClassLoader parent){
 	super(EMPTY_URLS,parent);
 }
 
-public Class defineClass(String name, byte[] bytes){
-    Map.Entry<WeakReference<Class>,Integer> ce = classCache.get(name);
+public Class defineClass(String name, byte[] bytes, Object srcForm){
+    Map.Entry<WeakReference<Class>,Object> ce = classCache.get(name);
     if(ce != null)
         {
         WeakReference<Class> cr = ce.getKey();
         Class c = cr.get();
-        if(c != null && Arrays.hashCode(bytes) == ce.getValue())
+        if((c != null) && srcForm.equals(ce.getValue()))
             return c;
         }
 	Class c = defineClass(name, bytes, 0, bytes.length);
-    classCache.put(name, new MapEntry(new WeakReference(c), Arrays.hashCode(bytes)));
+    classCache.put(name, new MapEntry(new WeakReference(c), srcForm));
     return c;
 }
 
 protected Class<?> findClass(String name) throws ClassNotFoundException{
-    Map.Entry<WeakReference<Class>,Integer> ce = classCache.get(name);
+    Map.Entry<WeakReference<Class>,Object> ce = classCache.get(name);
     if(ce != null)
         {
         WeakReference<Class> cr = ce.getKey();