primitive field assignment

primassign.clj

(import (clojure.asm Type ClassWriter Opcodes)
        (clojure.asm.commons Method GeneratorAdapter)
        (clojure.lang DynamicClassLoader Compiler$HostExpr))

(require '[clojure.string :as s])

(defn- struct-bytecode [cname slots]
  (let [objtype (Type/getType ^Class Object)
        cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))]
    (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL))
                 cname nil (. objtype (getInternalName))
                 (into-array String nil)))
    (doseq [slot slots]
      (let [tag (get (meta slot) :tag 'Object)]
        (. cv (visitField (. Opcodes ACC_PUBLIC) (Compiler/munge (name slot))
                          (. (Type/getType ^Class (or (Compiler$HostExpr/maybeSpecialTag tag)
                                                      (Compiler$HostExpr/maybeClass tag true)))
                             getDescriptor)
                          nil nil))))
    (let [method (new Method "<init>" (. Type VOID_TYPE) (into-array Type nil))
          gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) method nil nil cv)]
      (. gen (visitCode))
      (. gen (loadThis))
      (. gen (dup))
      (. gen (loadArgs))
      (. gen (invokeConstructor objtype method))
      (. gen (returnValue))
      (. gen (endMethod)))
    (. cv (visitEnd))
    (. cv (toByteArray))))

(defn genstruct [slots]
  (let [npath (s/split (str *ns*) #"\.")
        spath (conj (pop npath) (str (peek npath) "$" (gensym "struct__")))
        pname (namespace-munge (s/join "." spath))
        cname (namespace-munge (s/join "/" spath))
        bcode (struct-bytecode cname slots)
        sname (with-meta (symbol pname) {:no-doc true})]
    (when *compile-files* (Compiler/writeClassFile cname bcode))
    (intern *ns* sname
            (.defineClass ^DynamicClassLoader (deref Compiler/LOADER)
                          pname bcode nil))
    (list 'new sname)))

(defmacro example []
  (genstruct [(with-meta 'field {:tag 'int})]))

(defn tst []
  (set! (.-field (example)) (unchecked-inc 0)))