asm.clj

(import '(clojure.asm ClassWriter Opcodes Label))

(defn field [cw access name desc signature value]
  (.visitEnd (.visitField cw access name desc signature value)))

(defmacro method
  "classwritter, access bits, name of the class"
  [cw [access name desc signature exceptions] & body]
  `(doto ~cw
       ((fn [x#]
	  (let [w# (.visitMethod x# ~access ~name ~desc ~signature
				 (into-array String ~exceptions))]
	    (.visitCode w#)
	    (ops w# ~@body)
	    (maxs w#)
	    (.visitEnd w#))))))

(defn label [x]
  (Label.))

(def label (memoize label))

(defmacro op
  ([obj I] `(.visitInsn ~obj (. Opcodes ~I)))
  ([obj I addr]
     (cond (= I 'LABEL)
	     `(.visitLabel ~obj (label ~addr))
	   (= I 'NEW)
	     `(.visitTypeInsn ~obj (. Opcodes ~I) ~addr)
	   :else
	     `(.visitVarInsn ~obj (. Opcodes ~I) ~addr)))
  ([obj I target name sig]
     (cond (or (= I 'PUTFIELD) (= I 'GETFIELD)) 
	     `(.visitFieldInsn ~obj (. Opcodes ~I) ~target ~name ~sig)	   
	   :else
	     `(.visitMethodInsn ~obj (. Opcodes ~I) ~target ~name ~sig))))

(defmacro maxs
  ([obj] `(maxs ~obj 0 0))
  ([obj x y] `(.visitMaxs ~obj ~x ~y)))

(defmacro ops [obj & os]
  (let [x (map #(if (list? %) (cons 'op %) (list 'op %)) os)]
    `(doto ~obj ~@x)))

(defmacro make-class [name super faces & body]
  `(doto (ClassWriter. ClassWriter/COMPUTE_FRAMES)
     (.visit Opcodes/V1_5 Opcodes/ACC_PUBLIC
	     ~name nil ~super ~faces)
     ~@body
     .visitEnd
     ((fn [x#]
	(-> "%s.class" (format ~name)
	    java.io.File.
	    java.io.FileOutputStream.
	    (.write (.toByteArray x#)))))))

(make-class "foo/classloader" "java/lang/ClassLoader" nil
	    (field Opcodes/ACC_PUBLIC "loaders" "Ljava/util/List;" nil nil)
	    (method [Opcodes/ACC_PUBLIC
		     "<init>" "(Ljava/lang/ClassLoader;)V" nil nil]
		    (ALOAD 0)
		    DUP
		    (ALOAD 1)
		    (INVOKESPECIAL "java/lang/ClassLoader"
				   "<init>" "(Ljava/lang/ClassLoader;)V")
		    (NEW "java/util/ArrayList")
		    DUP
		    (INVOKESPECIAL "java/util/ArrayList" "<init>" "()V")
		    (PUTFIELD "foo/classloader" "loaders" "Ljava/util/List;")
		    RETURN)
	    (method [Opcodes/ACC_PUBLIC "add" "(Ljava/lang/Object;)V"
		     nil nil]
		    (ALOAD 0)
		    (GETFIELD "foo/classloader" "loaders" "Ljava/util/List;")
		    (ALOAD 1)
		    (INVOKEINTERFACE "java/util/List" "add"
				     "(Ljava/lang/Object;)Z")
		    RETURN)
	    (method [Opcodes/ACC_PROTECTED "findClass"
		     "(Ljava/lang/String;)Ljava/lang/Class;"
		     nil nil]
		    (LABEL :foo)
		    ACONST_NULL
		    ARETURN))