diff options
| -rw-r--r-- | src/lang.clj | 1 | ||||
| -rw-r--r-- | src/lang/analyser.clj | 158 | ||||
| -rw-r--r-- | src/lang/compiler.clj | 228 | ||||
| -rw-r--r-- | test2.lang | 17 |
4 files changed, 242 insertions, 162 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) diff --git a/test2.lang b/test2.lang index e300ce256..8f9b7c817 100644 --- a/test2.lang +++ b/test2.lang @@ -27,19 +27,24 @@ (def (constant x y) x) +(def (constant2 x) + (lambda [y] x)) + (def (main args) (if true - (let output "IT WORKS!" - (_. (_.. System out) (println ((lambda [x y] output) "TRUE" "YOLO")))) + (let f (lambda [x] (lambda [y] (x y))) + (let g (lambda [x] x) + (_. (_.. System out) (println (f g "WE'VE GOT CLOSURES!"))))) (_. (_.. System out) (println "FALSE")))) -## Doesn't work yet... -#( (let output "IT WORKS!" - (_. (_.. System out) (println (((lambda [x] (lambda [y] output)) "TRUE") "YOLO")))) )# - ## All of these work :D #( (let output "IT WORKS!" (_. (_.. System out) (println ((lambda [x y] output) "TRUE" "YOLO")))) )# +#( (let output "IT WORKS!" + (let f (lambda [x] (lambda [y] output)) + (_. (_.. System out) (println (f "TRUE" "YOLO"))))) )# +#( (let output "IT WORKS!" + (_. (_.. System out) (println ((lambda [x] (lambda [y] output)) "TRUE" "YOLO")))) )# #( (let output ((lambda [x y] x) "TRUE" "YOLO") (_. (_.. System out) (println output))) )# #( (let f (lambda [x y] x) |