diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lang/compiler.clj | 179 |
1 files changed, 105 insertions, 74 deletions
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index 5b14410b3..9de072bc0 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -266,7 +266,7 @@ (assert (compile-form (assoc *state* :form ?body)) "CAN't COMPILE LET-BODY") (.visitLabel *writer* end-label))) -(defn ^:private compile-method-function [writer class-name fn-name num-args] +(defn ^:private compile-method-function [writer class-name fn-name num-args body *state*] (let [outer-class (->class class-name) clo-field-sig (->type-signature "java.lang.Object") counter-sig "I" @@ -277,13 +277,19 @@ init-signature (if (not= 0 num-captured) (str "(" (apply str counter-sig (repeat num-captured clo-field-sig)) ")" "V") (str "()" "V"))] - (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) + ;; (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) current-class nil "java/lang/Object" (into-array ["test2/Function"])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) (.visitEnd)) (->> (when (not= 0 num-captured))))) + =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "impl" real-signature nil nil) + (.visitCode) + (->> (assoc *state* :form body :writer) compile-form) + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)) =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil) (.visitCode) (.visitVarInsn Opcodes/ALOAD 0) @@ -356,7 +362,7 @@ (->> (dotimes [clo_idx num-captured])))) (->> (when (not= 0 num-captured)))) (.visitVarInsn Opcodes/ALOAD 1) - (.visitMethodInsn Opcodes/INVOKESTATIC outer-class fn-name real-signature) + (.visitMethodInsn Opcodes/INVOKESTATIC current-class "impl" real-signature) ;; (.visitLabel end-label) (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) @@ -388,88 +394,113 @@ (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))) - (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;") - ;; _ (prn 'signature signature) - =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil) - (.visitCode))] - (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) - (doto =method - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (compile-method-function *writer* *class-name* ?name (count ?args))))) + ;; (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;") + ;; ;; _ (prn 'signature signature) + ;; =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil) + ;; (.visitCode))] + ;; (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) + ;; (doto =method + ;; (.visitInsn Opcodes/ARETURN) + ;; (.visitMaxs 0 0) + ;; (.visitEnd)) + ;; (compile-method-function *writer* *class-name* ?name (count ?args) ?body)) + (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*))) ))) (defcompiler ^:private compile-lambda [::&analyser/lambda ?args ?body] (let [num-args (count ?args) - signature (str "(" (apply str (repeat num-args "Ljava/lang/Object;")) ")" "Ljava/lang/Object;") outer-class (->class *class-name*) clo-field-sig (->type-signature "java.lang.Object") + counter-sig "I" apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;" - real-signature (str "(" (apply str (repeat num-args "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")] - (doseq [idx (range num-args) - :let [has-next? (not= idx (dec num-args)) - local-name (str "lambda_" idx) - current-class (str outer-class "$" local-name) - next-class (str outer-class "$" "lambda_" (inc idx)) - current-signature (str "(" (apply str (repeat idx "Ljava/lang/Object;")) ")" "V") - next-signature (str "(" (apply str (repeat (inc idx) "Ljava/lang/Object;")) ")" "V")]] - (.visitInnerClass *parent* current-class outer-class local-name (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"]))) - _ (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" current-signature nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ALOAD (inc clo_idx)) - (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig)) - (->> (let [field-name (str "_" clo_idx)] - (doto (.visitField =class Opcodes/ACC_PUBLIC field-name clo-field-sig nil nil) - (.visitEnd))) - (dotimes [clo_idx idx]))) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - =method (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil) - (.visitCode)) - _ (do (when has-next? - (doto =method - (.visitTypeInsn Opcodes/NEW next-class) - (.visitInsn Opcodes/DUP))) - (doto =method - (-> (doto (.visitVarInsn Opcodes/ALOAD (int 0)) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) - (->> (dotimes [clo_idx idx]))) - (.visitVarInsn Opcodes/ALOAD (int 1))) - (if has-next? - (.visitMethodInsn =method Opcodes/INVOKESPECIAL next-class "<init>" next-signature) - (.visitMethodInsn =method Opcodes/INVOKESTATIC outer-class "lambda_impl" real-signature)) - (doto =method + real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;") + current-class (str outer-class "$" "lambda") + num-captured (dec num-args) + init-signature (if (not= 0 num-captured) + (str "(" (apply str counter-sig (repeat num-captured clo-field-sig)) ")" "V") + (str "()" "V"))] + ;; (.visitInnerClass *parent* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) + (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) + current-class nil "java/lang/Object" (into-array ["test2/Function"])) + (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) + (.visitEnd)) + (->> (when (not= 0 num-captured))))) + =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil) + (.visitCode) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") + (-> (doto (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig) + (-> (doto (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ALOAD (+ clo_idx 2)) + (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig)) + (->> (let [field-name (str "_" clo_idx)] + (doto (.visitField =class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil) + (.visitEnd))) + (dotimes [clo_idx num-captured])))) + (->> (when (not= 0 num-captured)))) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd)) + =method (let [default-label (new Label) + branch-labels (for [_ (range num-captured)] + (new Label))] + (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil) + (.visitCode) + (-> (doto (.visitVarInsn Opcodes/ALOAD 0) + (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) + (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels)) + (-> (doto (.visitLabel branch-label) + (.visitTypeInsn Opcodes/NEW current-class) + (.visitInsn Opcodes/DUP) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) + (.visitInsn Opcodes/ICONST_1) + (.visitInsn Opcodes/IADD) + (-> (doto (.visitVarInsn Opcodes/ALOAD 0) + (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) + (->> (dotimes [clo_idx current-captured]))) + (.visitVarInsn Opcodes/ALOAD 1) + (-> (.visitInsn Opcodes/ACONST_NULL) + (->> (dotimes [clo_idx (- (dec num-captured) current-captured)]))) + (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature) + ;; (.visitJumpInsn Opcodes/GOTO end-label) + (.visitInsn Opcodes/ARETURN)) + (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels))) + ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])] + ]))) + (.visitLabel default-label) + (-> (doto (.visitVarInsn Opcodes/ALOAD 0) + (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) + (->> (dotimes [clo_idx num-captured])))) + (->> (when (not= 0 num-captured)))) + (.visitVarInsn Opcodes/ALOAD 1) + (.visitMethodInsn Opcodes/INVOKESTATIC current-class "impl" real-signature) + ;; (.visitLabel end-label) + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd))) + =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "impl" real-signature nil nil) + (.visitCode) + (->> (assoc *state* :form ?body :writer) + compile-form) (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) - (.visitEnd =class))] - (println "OUTPUT LAMBDA:" (str current-class ".class")) - (write-file (str current-class ".class") (.toByteArray =class)))) - (let [=method (doto (.visitMethod *parent* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "lambda_impl" real-signature nil nil) - (.visitCode))] - ;; (prn '(:form ?body) (:form ?body)) - (compile-form (assoc *state* :parent *parent* :writer =method :form ?body)) - (doto =method - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)) - ;; (compile-form (assoc *state* :writer =method :form ?body)) - ;; (compile-method-function *writer* *class-name* ?name (count ?args)) - ) - (let [init-class (str outer-class "$" "lambda_0")] - (doto *writer* - (.visitTypeInsn Opcodes/NEW init-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL init-class "<init>" "()V"))) + _ (.visitEnd =class)] + (write-file (str current-class ".class") (.toByteArray =class))) + (doto *writer* + (.visitTypeInsn Opcodes/NEW current-class) + (.visitInsn Opcodes/DUP) + (-> (doto (.visitInsn Opcodes/ICONST_0) + ;; (.visitInsn Opcodes/ICONST_0) + (-> (.visitInsn Opcodes/ACONST_NULL) + (->> (doseq [_ (butlast ?args)])))) + (->> (when (> (count ?args) 1)))) + (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)) )) (defcompiler ^:private compile-defclass |