aboutsummaryrefslogtreecommitdiff
path: root/src/lang/compiler.clj
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang/compiler.clj228
1 files changed, 125 insertions, 103 deletions
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index f2c57f410..bd64563e8 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -119,16 +119,16 @@
(defcompiler ^:private compile-local
[::&analyser/local ?env ?idx]
- (do (prn 'LOCAL ?idx)
+ (do ;; (prn 'LOCAL ?idx)
(doto *writer*
(.visitVarInsn Opcodes/ALOAD (int ?idx)))))
(defcompiler ^:private compile-captured
- [::&analyser/captured ?closure-id ?captured-id ?source]
- (do (prn 'CAPTURED [?closure-id ?captured-id])
+ [::&analyser/captured ?scope ?captured-id ?source]
+ (do (prn 'CAPTURED [?scope ?captured-id])
(doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD (str "test2" "$" "lambda") (str "__" (inc ?captured-id)) "Ljava/lang/Object;"))))
+ (.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;"))))
(defcompiler ^:private compile-global
[::&analyser/global ?owner-class ?name]
@@ -311,10 +311,10 @@
;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/Object;)V")
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ILOAD 1)
+ (.visitVarInsn Opcodes/ILOAD 1)
;; (.visitInsn Opcodes/ICONST_0)
- (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
+ (.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))
@@ -414,118 +414,140 @@
(compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*)))
)))
+(defn ^:private captured? [form]
+ (match form
+ [::&analyser/captured ?closure-id ?captured-id ?source]
+ true
+ _
+ false))
+
(defcompiler ^:private compile-lambda
- [::&analyser/lambda ?frame ?args ?body]
- (let [_ (prn '?frame ?frame)
+ [::&analyser/lambda ?scope ?frame ?args ?body]
+ (let [_ (prn '[?scope ?frame] ?scope ?frame)
num-args (count ?args)
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 clo-field-sig)) ")" "Ljava/lang/Object;")
- current-class (str outer-class "$" "lambda")
+ current-class (apply str (interpose "$" ?scope))
num-captured (dec num-args)
- init-signature (if (not= 0 num-captured)
- (str "(" (apply str (repeat (count (:mappings ?frame)) clo-field-sig))
- counter-sig
- (apply str (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 (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
- (.visitFieldInsn Opcodes/PUTFIELD current-class captured-name clo-field-sig))
- (do (doto =class
- (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
- (.visitEnd)))
- (->> (let [captured-name (str "__" (inc ?captured-id))])
- (match (:form ?captured)
- [::&analyser/captured ?closure-id ?captured-id ?source])
- (doseq [[?name ?captured] (:mappings ?frame)])))
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ILOAD (inc (count (:mappings ?frame))))
- (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
- (.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])
- (let [offset (+ 2 (count (:mappings ?frame)))]))))
- (->> (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)
- (.visitVarInsn Opcodes/ALOAD 0)
+ init-signature (str "(" (apply str (repeat (->> (:mappings ?frame)
+ (map (comp :form second))
+ (filter captured?)
+ count)
+ clo-field-sig))
+ (if (not= 0 num-captured)
+ (apply str counter-sig (repeat num-captured clo-field-sig)))
+ ")"
+ "V")
+ _ (prn current-class 'init-signature init-signature)
+ _ (prn current-class 'real-signature real-signature)
+ =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) captured-name clo-field-sig nil nil)
+ (.visitEnd))
+ (->> (let [captured-name (str "__" ?captured-id)])
+ (match (:form ?captured)
+ [::&analyser/captured ?closure-id ?captured-id ?source])
+ (doseq [[?name ?captured] (:mappings ?frame)
+ :when (captured? (:form ?captured))])))
+ (-> (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/ALOAD (inc ?captured-id))
+ (.visitFieldInsn Opcodes/PUTFIELD current-class captured-name clo-field-sig))
+ (->> (let [captured-name (str "__" ?captured-id)])
+ (match (:form ?captured)
+ [::&analyser/captured ?closure-id ?captured-id ?source])
+ (doseq [[?name ?captured] (:mappings ?frame)
+ :when (captured? (:form ?captured))])))
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ILOAD (inc (count (:mappings ?frame))))
+ (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
(-> (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)
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD current-class (str "__" (inc capt_idx)) clo-field-sig))
- (->> (dotimes [capt_idx (count (:mappings ?frame))])))
- (.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/INVOKEVIRTUAL current-class "impl" real-signature)
- ;; (.visitLabel end-label)
- (.visitInsn Opcodes/ARETURN)
- (.visitMaxs 0 0)
- (.visitEnd)))
- _ (prn 'LAMBDA/?body ?body)
- =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)]
- (write-file (str current-class ".class") (.toByteArray =class)))
+ (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
+ (.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])
+ (let [offset (+ 2 (count (:mappings ?frame)))]))))
+ (->> (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)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (-> (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)
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitFieldInsn Opcodes/GETFIELD current-class (str "__" capt_idx) clo-field-sig))
+ (->> (dotimes [capt_idx (count (:mappings ?frame))])))
+ (.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/INVOKEVIRTUAL current-class "impl" real-signature)
+ ;; (.visitLabel end-label)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; _ (prn 'LAMBDA/?body ?body)
+ =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)]
+ (write-file (str current-class ".class") (.toByteArray =class))
+ (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
+ (map second)
+ (map :form)
+ (filter captured?)))
(doto *writer*
(.visitTypeInsn Opcodes/NEW current-class)
(.visitInsn Opcodes/DUP)
(-> (do (compile-form (assoc *state* :form ?source)))
(->> (match (:form ?captured)
[::&analyser/captured ?closure-id ?captured-id ?source])
- (doseq [[?name ?captured] (:mappings ?frame)])))
+ (doseq [[?name ?captured] (:mappings ?frame)
+ :when (captured? (:form ?captured))])))
(-> (doto (.visitInsn Opcodes/ICONST_0)
;; (.visitInsn Opcodes/ICONST_0)
(-> (.visitInsn Opcodes/ACONST_NULL)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:34:39 +0000