diff options
author | Eduardo Julian | 2015-01-16 11:26:17 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-01-16 11:26:17 -0400 |
commit | 90e35a2d13c78c8d7a3db3020bf6a66a5fe04604 (patch) | |
tree | 1803231a22c7e62aa5181cfee6450765f584f907 | |
parent | d1e7c4dd03a72a93dbca15cbc1b0ac29ab49efbc (diff) |
[Bugs]
- Not all outside vars needed by lambdas were actually captured.
- Needed vars weren't always captured in the right order.
- The names of global-var classes weren't being generated properly to account for symbols/punctuation.
[Enhancements]
- The system now uses a brand-new ClassLoader on every run to speed-up development.
-rw-r--r-- | src/lux/analyser.clj | 40 | ||||
-rw-r--r-- | src/lux/compiler.clj | 15 | ||||
-rw-r--r-- | test2.lux | 28 |
3 files changed, 59 insertions, 24 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 1aa2d587b..b192a2e31 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -156,7 +156,7 @@ (match =return [::&util/ok [?state ?value]] (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first)) - [::&util/ok [(update-in ?state [:env] #(cons (assoc (first %) :mappings (-> state :env first :mappings)) + [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] (fn [m] (apply dissoc m (keys mappings)))) (rest %))) ?value]]) @@ -184,6 +184,8 @@ [::&util/ok [?state ?value]] (do ;; (prn 'PRE-LAMBDA (:env state)) ;; (prn 'POST-LAMBDA (:env ?state) ?value) + (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings)) + (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings)) [::&util/ok [(-> ?state (update-in [:env] rest) ;; (update-in [:lambda-scope 1] inc) @@ -221,26 +223,30 @@ [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])) (let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))] (cond (empty? inner) - [::&util/ok [state (-> state :env first :mappings (get ident))]] + (do (prn 'resolve/inner ident (get-in state [:lambda-scope 0])) + [::&util/ok [state (-> state :env first :mappings (get ident))]]) (empty? outer) - (if-let [global|import (or (get-in state [:defs-env ident]) - (get-in state [:imports ident]))] - [::&util/ok [state global|import]] - [::&util/failure (str "Unresolved identifier: " ident)]) + (do (prn 'resolve/outer ident (get-in state [:lambda-scope 0])) + (if-let [global|import (or (get-in state [:defs-env ident]) + (get-in state [:imports ident]))] + [::&util/ok [state global|import]] + [::&util/failure (str "Unresolved identifier: " ident)])) :else - (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)) '()] - (map vector - (reverse inner) - (->> (get-in state [:lambda-scope 0]) - (iterate pop) - (take (count inner)) - reverse)))] - [::&util/ok [(assoc state :env (concat inner* outer)) =local]])))))) + (do (prn 'resolve/:else ident (get-in state [:lambda-scope 0])) + (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)) '()] + (map vector + (reverse inner) + (->> (get-in state [:lambda-scope 0]) + (iterate pop) + (take (count inner)) + reverse)))] + (prn 'resolve/inner* inner*) + [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))))))) (defmacro ^:private defanalyser [name match return] `(def ~name diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 31b440b88..5b257eaed 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -699,7 +699,7 @@ (defn compile-field [writer class-name ?name body state] (let [outer-class (->class class-name) datum-sig (->type-signature "java.lang.Object") - current-class (str outer-class "$" ?name)] + current-class (str outer-class "$" (normalize-ident ?name))] (.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) @@ -866,14 +866,23 @@ ;; (map second) ;; (map :form) ;; (filter captured?))) + ;; (prn 'M2 (:mappings ?frame)) + ;; (prn 'M2 (->> (:mappings ?frame) + ;; (filter (comp captured? :form second)))) + ;; (prn 'M3 (->> (:mappings ?frame) + ;; (filter (comp captured? :form second)) + ;; (sort #(< (-> %1 second :form (nth 2)) + ;; (-> %2 second :form (nth 2)))))) (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) - :when (captured? (:form ?captured))]))) + (doseq [[?name ?captured] (->> (:mappings ?frame) + (filter (comp captured? :form second)) + (sort #(< (-> %1 second :form (nth 2)) + (-> %2 second :form (nth 2)))))]))) (-> (doto (.visitInsn Opcodes/ICONST_0) ;; (.visitInsn Opcodes/ICONST_0) (-> (.visitInsn Opcodes/ACONST_NULL) @@ -150,7 +150,7 @@ (#Failure message)) (def (return* state value) - (#Ok state value)) + (#Ok [state value])) (def (fail message) (lambda [state] @@ -158,13 +158,13 @@ (def (return value) (lambda [state] - (#Ok state value))) + (#Ok [state value]))) (def (bind m-value step) (lambda [state] (let inputs (m-value state) (case inputs - (#Ok ?state ?datum) + (#Ok [?state ?datum]) (step ?datum ?state) _ @@ -294,6 +294,19 @@ (do (print "[") (print idx) (print ":") (print x) (print "]") (print " ") (print-enum enum')))) +(def get-state + (lambda [state] + (#Ok [state state]))) + +(def monadic-dup + (exec [foo get-state + bar get-state + baz (return 1000)] + (return (+ (+ foo bar) baz)))) + +(def (run-state monad state) + (monad state)) + ## Program (def (main args) (case (' ((~ "Oh yeah..."))) @@ -313,7 +326,14 @@ (println (= false true)) (println (= true false)) (println (= true true)) - (print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e")))) + (case (run-state monadic-dup 123) + (#Ok [_ ?value]) + (println ?value) + + (#Failure ?message) + (println ?message)) + (print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e"))) + ) )) #( (def (main args) |