aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj12
-rw-r--r--src/lux/base.clj11
-rw-r--r--src/lux/compiler/lambda.clj5
-rw-r--r--src/lux/compiler/lux.clj7
-rw-r--r--src/lux/optimizer.clj43
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
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 05:31:31 +0000