From 067a1900e73c40c502f57b6d54a49549c968db83 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Dec 2014 23:40:31 -0400 Subject: Now the language has full closures. --- src/lang/compiler.clj | 228 +++++++++++++++++++++++++++----------------------- 1 file changed, 125 insertions(+), 103 deletions(-) (limited to 'src/lang/compiler.clj') 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-signature nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()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-signature nil nil) + (.visitCode) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()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-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-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) -- cgit v1.2.3