non-importing-defrecord.clj

(defmacro my-defrecord
  [name [& fields] & opts+specs]
  (let [gname name
        [interfaces methods opts] (#'clojure.core/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
       ~(#'clojure.core/emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
       (defmethod print-method ~classname [o# w#]
           ((var clojure.core/print-defrecord) o# w#))
       #_(import ~classname)
       (defn ~name
         ([~@fields] (new ~classname ~@fields nil nil))
         ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))
         {:host-constructor ~classname}))))

(defmacro my-new [class-or-varname & args]
  (let [resolved (resolve class-or-varname)]
    (cond
      (class? resolved) `(new ~class-or-varname ~@args)
      (and (var? resolved) (:host-constructor (meta resolved)))
        `(new ~(:host-constructor (meta resolved)) ~@args)
      :else (throw (IllegalArgumentException.)))))

(defn myextend [atype & proto+mmaps]
  (if (fn? atype)
    (if-let [type (-> atype meta :host-constructor resolve)]
      (apply extend type proto+mmaps))
    (apply extend atype proto+mmaps)))


(comment
user> (defprotocol P (what [p]))
P
user> (my-defrecord Foo [val] P (what [_] (str :old val)))
#'user/Foo
user> (Foo 1)
#:user.Foo{:val 1}
user> (Foo :ha)
#:user.Foo{:val :ha}
user> (my-new Foo :ha)
#:user.Foo{:val :ha}
user> (macroexpand '(my-new Foo :ha))
(new user.Foo :ha)
user> (defn call-what-on-a-dynamic-Foo [] (what (Foo)))
#'user/call-what-on-a-dynamic-Foo
user> (defn call-what-on-a-dynamic-Foo [] (what (Foo nil)))
#'user/call-what-on-a-dynamic-Foo
user> (defn call-what-on-a-static-Foo [] (what (my-new Foo nil)))
#'user/call-what-on-a-static-Foo
user> (call-what-on-a-static-Foo)
":old"
user> (call-what-on-a-dynamic-Foo)
":old"
user> (my-defrecord Foo [val] P (what [_] (str :new-and-better val)))
#'user/Foo
user> (call-what-on-a-static-Foo)
":old"
user> (call-what-on-a-dynamic-Foo)
":new-and-better"

)