aboutsummaryrefslogtreecommitdiff
path: root/src/lang
diff options
context:
space:
mode:
Diffstat (limited to 'src/lang')
-rw-r--r--src/lang/compiler.clj179
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