diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser/host.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 12 | ||||
| -rw-r--r-- | src/lux/base.clj | 11 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 5 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 7 | ||||
| -rw-r--r-- | src/lux/optimizer.clj | 43 |
6 files changed, 26 insertions, 54 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 87a174f7f..be69dc54c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -971,7 +971,7 @@ (&/with-closure (|do [module &/get-module-name scope &/get-scope-name - :let [name (&host/location (&/|tail scope)) + :let [name (->> scope &/|reverse &/|tail &host/location) class-decl (&/T [name &/$Nil]) anon-class (str (string/replace module "/" ".") "." name) anon-class-type (&/$HostT anon-class &/$Nil)] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6ecd45974..b78908922 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -292,16 +292,16 @@ (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) (fail* (str "[Analyser Error] Unknown global definition: " name))) - (&/$Cons top-outer _) + (&/$Cons bottom-outer _) (|let [scopes (&/|tail (&/folds #(&/$Cons (&/get$ &/$name %2) %1) (&/|map #(&/get$ &/$name %) outer) (&/|reverse inner))) [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] (|let [[register new-inner] register+new-inner - [register* frame*] (&&lambda/close-over (&/|reverse in-scope) name register frame)] + [register* frame*] (&&lambda/close-over (&/get-cached-scope-name in-scope) name register frame)] (&/T [register* (&/$Cons frame* new-inner)]))) - (&/T [(or (->> top-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name)) - (->> top-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name))) + (&/T [(or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name)) + (->> bottom-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name))) &/$Nil]) (&/|reverse inner) scopes)] ((|do [_ (&type/check exo-type (&&/expr-type* =local))] @@ -388,8 +388,8 @@ ((&/fail-with-loc error) state))) module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (or (and (= "lux/data/maybe" r-prefix) - ;; (= "?" r-name)) + ;; _ (when (or (and (= "lux" r-prefix) + ;; (= "do" r-name)) ;; ;; (= "@type" r-name) ;; ) ;; (->> (&/|map &/show-ast macro-expansion) diff --git a/src/lux/base.clj b/src/lux/base.clj index be66632c5..0d9fcebe8 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -914,9 +914,18 @@ (|tail %)) state)))))) +(let [cache (atom {})] + (defn get-cached-scope-name [raw] + (let [signature (fold (fn [tail head] (str head "\t" tail)) + "" + raw)] + (or (get @cache signature) + (do (swap! cache assoc signature raw) + raw))))) + (def get-scope-name (fn [state] - (return* state (->> state (get$ $envs) (|map #(get$ $name %)) |reverse)))) + (return* state (get-cached-scope-name (->> state (get$ $envs) (|map #(get$ $name %))))))) (defn with-writer [writer body] (fn [state] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index f51edc507..32650e262 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -243,8 +243,9 @@ datum-flags (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL)] (defn compile-function [compile ?prev-writer arity ?scope ?env ?body] (|do [[file-name _ _] &/cursor - :let [name (&host/location (&/|tail ?scope)) - class-name (str (&host/->module-class (&/|head ?scope)) "/" name) + :let [??scope (&/|reverse ?scope) + name (&host/location (&/|tail ??scope)) + class-name (str (&host/->module-class (&/|head ??scope)) "/" name) [=class save?] (|case ?prev-writer (&/$Some _writer) (&/T [_writer false]) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index af20a3365..e3cf37584 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -96,11 +96,12 @@ (return nil))) (defn compile-captured [compile ?scope ?captured-id ?source] - (|do [^MethodVisitor *writer* &/get-writer + (|do [:let [??scope (&/|reverse ?scope)] + ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) (.visitFieldInsn Opcodes/GETFIELD - (str (&host/->module-class (&/|head ?scope)) "/" (&host/location (&/|tail ?scope))) + (str (&host/->module-class (&/|head ??scope)) "/" (&host/location (&/|tail ??scope))) (str &&/closure-prefix ?captured-id) "Ljava/lang/Object;"))]] (return nil))) @@ -234,7 +235,7 @@ _ (|case (de-ann ?body) [_ (&o/$function _ __scope _ _)] - (|let [[_ (&o/$function _arity _scope _captured ?body+)] (&o/shift-function-body (&/|but-last __scope) __scope + (|let [[_ (&o/$function _arity _scope _captured ?body+)] (&o/shift-function-body (&/get-cached-scope-name (&/|tail __scope)) __scope false (de-ann ?body))] (|do [:let [=value-type (&a/expr-type* ?body)] diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 4788536fe..c03515370 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -216,36 +216,7 @@ (defn ^:private de-scope [old-scope new-scope scope] "(-> Scope Scope Scope Scope)" - (if (or (and (identical? new-scope scope) - ;; (do (prn 'SIMPLE-WAS-ENOUGH) true) - ) - (do ;; (prn 'LONG-TEST!) - (and (= (&/|length new-scope) - (&/|length scope)) - (do ;; (prn 'FULL-TEST! (&/->seq new-scope) (&/->seq scope)) - (loop [new-scope* new-scope - scope* scope] - (|case new-scope* - (&/$Nil) - (|case scope* - (&/$Nil) true - _ false) - - (&/$Cons _new new-scope**) - (|case scope* - (&/$Cons _current scope**) - (if (= _new _current) - (recur new-scope** scope**) - false) - - _ - false))) - ;; (&/|every? (fn [nc] - ;; (|let [[_new _current] nc] - ;; (= _new _current))) - ;; (&/zip2 new-scope scope)) - )) - )) + (if (identical? new-scope scope) old-scope scope)) @@ -335,7 +306,7 @@ ))) (defn ^:private optimize-loop [arity optim] - "(-> Int Optimized [Optimized Bool])" + "(-> Int Optimized Optimized)" (|let [[meta optim-] optim] (|case optim- ($apply [meta-0 ($var (&/$Local 0))] _args) @@ -343,10 +314,6 @@ (&/T [meta-0 ($loop (&/|map (partial optimize-loop -1) _args))]) optim) - ($apply func args) - (&/T [meta ($apply (optimize-loop -1 func) - (&/|map (partial optimize-loop -1) args))]) - ($case _value [_pattern _bodies]) (&/T [meta ($case _value (&/T [_pattern @@ -359,12 +326,6 @@ ($ann _value-expr _type-expr _type-type) (&/T [meta ($ann (optimize-loop arity _value-expr) _type-expr _type-type)]) - ($variant idx is-last? value) - (&/T [meta ($variant idx is-last? (optimize-loop -1 value))]) - - ($tuple elems) - (&/T [meta ($tuple (&/|map (partial optimize-loop -1) elems))]) - _ optim ))) |