aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2014-12-19 23:40:31 -0400
committerEduardo Julian2014-12-19 23:40:31 -0400
commit067a1900e73c40c502f57b6d54a49549c968db83 (patch)
tree06c17dde99b227f2dbedcad75876b68081ac2d37 /src
parente4bcdcda60fec97622217840d54ae9ee2c121f72 (diff)
Now the language has full closures.
Diffstat (limited to '')
-rw-r--r--src/lang.clj1
-rw-r--r--src/lang/analyser.clj158
-rw-r--r--src/lang/compiler.clj228
3 files changed, 231 insertions, 156 deletions
diff --git a/src/lang.clj b/src/lang.clj
index 0a958203b..84535356e 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -11,7 +11,6 @@
(.write stream data)))
(comment
- ;; TODO: Allow "lambdas" to be closures.
;; TODO: Add Java-interop.
;; TODO: Allow loading classes/modules at runtime.
;; TODO: Add macros.
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 109ba15f6..1e1be1d7b 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -41,6 +41,40 @@
(fn [state]
[::&util/ok [state (-> state :env first)]]))
+(defn ^:private with-scope [scope body]
+ (fn [state]
+ (let [=return (body (-> state
+ (update-in [:lambda-scope 0] conj scope)
+ (assoc-in [:lambda-scope 1] 0)))]
+ (match =return
+ [::&util/ok [?state ?value]]
+ [::&util/ok [(assoc ?state :lambda-scope (:lambda-scope state)) ?value]]
+
+ _
+ =return))))
+
+(defn ^:private with-lambda-scope [body]
+ (fn [state]
+ (let [_ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1]))
+ =return (body (-> state
+ (update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1]))
+ (assoc-in [:lambda-scope 1] 0)))]
+ (match =return
+ [::&util/ok [?state ?value]]
+ [::&util/ok [(do (prn [:lambda-scope 0] (get-in ?state [:lambda-scope 0]))
+ (prn [:lambda-scope 1] (get-in ?state [:lambda-scope 1]))
+ (-> ?state
+ (update-in [:lambda-scope 0] pop)
+ (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1])))))
+ ?value]]
+
+ _
+ =return))))
+
+(def ^:private scope
+ (fn [state]
+ [::&util/ok [state (get-in state [:lambda-scope 0])]]))
+
(defn ^:private with-local [name type body]
(fn [state]
(let [=return (body (update-in state [:env]
@@ -51,34 +85,49 @@
;; =return
(match =return
[::&util/ok [?state ?value]]
- (do (prn 'POST-WITH-LOCAL name (-> ?state :env first))
- [::&util/ok [(update-in ?state [:env] #(cons (-> (first %)
- (update-in [:counter] dec)
- (update-in [:mappings] dissoc name))
- (rest %)))
- ;; (update-in ?state [:env] (fn [[top & oframes]]
- ;; (prn 'NEW-FRAMES name (cons (-> state :env first (assoc :closure (-> top :closure))) oframes))
- ;; (cons (-> state :env first (assoc :closure (-> top :closure))) oframes)))
- ?value]])
+ (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first))
+ [::&util/ok [(update-in ?state [:env] #(cons (-> (first %)
+ (update-in [:counter] dec)
+ (update-in [:mappings] dissoc name))
+ (rest %)))
+ ;; (update-in ?state [:env] (fn [[top & oframes]]
+ ;; (prn 'NEW-FRAMES name (cons (-> state :env first (assoc :closure (-> top :closure))) oframes))
+ ;; (cons (-> state :env first (assoc :closure (-> top :closure))) oframes)))
+ ?value]])
_
=return)
)))
-(defn ^:private with-fresh-env [body]
- (fn [state]
- ;; (prn '(:env state) (:env state) (-> state :env first :id inc))
- (let [=return (body (update-in state [:env] #(conj % (fresh-env (-> % first :id inc)))))
- ;; _ (prn '=return =return)
- ]
- (match =return
- [::&util/ok [?state ?value]]
- (do (prn 'PRE-LAMBDA (:env state))
- (prn 'POST-LAMBDA (:env ?state) ?value)
- [::&util/ok [(assoc ?state :env (:env state)) [(-> ?state :env first) ?value]]])
-
- _
- =return))))
+(defn ^:private with-fresh-env [[args-vars args-types] body]
+ (with-lambda-scope
+ (fn [state]
+ ;; (prn '(:env state) (:env state) (-> state :env first :id inc))
+ (let [state* (update-in state [:env]
+ (fn [outer]
+ (let [frame-id (-> outer first :id inc)
+ new-top (reduce (fn [frame [name type]]
+ (-> frame
+ (update-in [:counter] inc)
+ (assoc-in [:mappings name] (annotated [::local frame-id (:counter frame)] type))))
+ (update-in (fresh-env frame-id) [:counter] inc)
+ (map vector args-vars args-types))]
+ (conj outer new-top))))
+ =return (body state*)
+ ;; _ (prn '=return =return)
+ ]
+ (match =return
+ [::&util/ok [?state ?value]]
+ (do (prn 'PRE-LAMBDA (:env state))
+ (prn 'POST-LAMBDA (:env ?state) ?value)
+ [::&util/ok [(-> ?state
+ (update-in [:env] rest)
+ ;; (update-in [:lambda-scope 1] inc)
+ )
+ [(get-in ?state [:lambda-scope 0]) (-> ?state :env first) ?value]]])
+
+ _
+ =return)))))
(defn ^:private import-class [long-name short-name]
(fn [state]
@@ -92,9 +141,9 @@
[::&util/ok [(assoc-in state [:deps alias] name)
nil]]))
-(defn ^:private close-over [ident register frame]
- (prn 'close-over ident register)
- (let [register* (annotated [::captured (:id frame) (:closure/id frame) register] (:type register))]
+(defn ^:private close-over [scope ident register frame]
+ ;; (prn 'close-over scope ident register)
+ (let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))]
[register* (-> frame
(update-in [:closure/id] inc)
(assoc-in [:mappings ident] register*))]))
@@ -120,11 +169,16 @@
[::&util/failure (str "Unresolved identifier: " ident)])
:else
- (let [[=local inner*] (reduce (fn [[register new-inner] frame]
- (let [[register* frame*] (close-over ident register frame)]
+ (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]]
+ (let [[register* frame*] (close-over scope ident register frame)]
[register* (cons frame* new-inner)]))
[(-> outer first :mappings (get ident)) '()]
- (reverse inner))
+ (map vector
+ (reverse inner)
+ (->> (get-in state [:lambda-scope 0])
+ (iterate pop)
+ (take (count inner))
+ reverse)))
_ (prn 'resolve/_4 '[=local inner*] =local inner*)]
[::&util/ok [(assoc state :env (concat inner* outer)) =local]])))
)))
@@ -184,7 +238,9 @@
;; ]
;; (resolve ?ident))
(exec [=ident (resolve ?ident)
- :let [_ (prn 'analyse-ident ?ident =ident)]]
+ ;; :let [_ (prn 'analyse-ident ?ident =ident)]
+ state &util/get-state
+ :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))]]
(return =ident)))
(defanalyser analyse-ann-class
@@ -286,7 +342,8 @@
[::&parser/def ?usage ?value]
(match ?usage
[::&parser/ident ?name]
- (exec [=value (analyse-form* ?value)
+ (exec [=value (with-scope ?name
+ (analyse-form* ?value))
_ (define ?name {:mode ::constant
:access ::public
:type (:type =value)})]
@@ -303,10 +360,11 @@
;; (assoc ?name =function)
;; (into (map vector args =args)))
;; _ (prn 'env env)]
- =value (reduce (fn [inner [label type]]
- (with-local label type inner))
- (analyse-form* ?value)
- (reverse (map vector args =args)))
+ =value (with-scope ?name
+ (reduce (fn [inner [label type]]
+ (with-local label type inner))
+ (analyse-form* ?value)
+ (reverse (map vector args =args))))
;; :let [_ (prn '=value =value)]
=function (within :types (exec [_ (&type/solve =return (:type =value))]
(&type/clean =function)))
@@ -325,20 +383,14 @@
;; :let [_ (prn 'PRE/?body ?body)]
;; _env (fn [state] [::&util/ok [state (:env state)]])
;; :let [_ (prn 'analyse-lambda _env)]
- [=frame =body] (with-fresh-env
- (reduce (fn [inner [label type]]
- (exec [=inner (with-local label type inner)
- =frame* my-frame
- :let [_ (prn '=frame* =frame*)]]
- (return =inner)))
- (analyse-form* ?body)
- (reverse (map vector ?args =args))))
+ [=scope =frame =body] (with-fresh-env [?args =args]
+ (analyse-form* ?body))
;; :let [_ (prn '=body =body)]
=function (within :types (exec [_ (&type/solve =return (:type =body))]
(&type/clean =function)))
;; :let [_ (prn '=function =function)]
]
- (return (annotated [::lambda =frame ?args =body] =function))))
+ (return (annotated [::lambda =scope =frame ?args =body] =function))))
(defanalyser analyse-import
[::&parser/import ?class]
@@ -380,14 +432,16 @@
;; [Interface]
(defn analyse [module-name tokens]
- (match ((repeat-m analyse-form) {:name module-name,
- :forms tokens
- :deps {}
- :imports {}
- :defs {}
- :defs-env {}
- :env (list (fresh-env 0))
- :types &type/+init+})
+ (match ((repeat-m (with-scope module-name
+ analyse-form)) {:name module-name,
+ :forms tokens
+ :deps {}
+ :imports {}
+ :defs {}
+ :defs-env {}
+ :lambda-scope [[] 0]
+ :env (list (fresh-env 0))
+ :types &type/+init+})
[::&util/ok [?state ?forms]]
(if (empty? (:forms ?state))
?forms
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)