aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/compiler/lux.clj6
-rw-r--r--src/lux/optimizer.clj94
2 files changed, 62 insertions, 38 deletions
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 180d1556b..d5481dbd8 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -216,8 +216,10 @@
_
(|case (de-ann ?body)
- [_ (&o/$function _ _ _ _)]
- (|let [[_ (&o/$function _arity _scope _captured ?body+)] (&o/shift-function-body false (de-ann ?body))]
+ [_ (&o/$function _ __scope _ _)]
+ (|let [[_ (&o/$function _arity _scope _captured ?body+)] (&o/shift-function-body (&/|but-last __scope) __scope
+ false
+ (de-ann ?body))]
(|do [:let [=value-type (&a/expr-type* ?body)]
;; ^ClassWriter *writer* &/get-writer
[file-name _ _] &/cursor
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 24636bf16..3e739d511 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -213,48 +213,70 @@
pattern
))
-(defn ^:private drop-scope [source]
- (|case source
- [meta ($captured scope idx source*)]
- (&/T [meta ($captured (&/|but-last scope) idx (drop-scope source*))])
-
- _
- source))
-
-(defn ^:private de-scope [scope]
- "(-> Scope Scope)"
- (|case scope
- (&/$Cons _module (&/$Cons _def (&/$Cons _level-to-remove _levels-to-keep)))
- (&/$Cons _module (&/$Cons _def _levels-to-keep))))
-
-(defn shift-function-body [own-body? body]
- "(-> Optimized Optimized)"
+(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))
+ ))
+ ))
+ old-scope
+ scope))
+
+(defn shift-function-body [old-scope new-scope own-body? body]
+ "(-> Scope Scope Bool Optimized Optimized)"
(|let [[meta body-] body]
(|case body-
($variant idx is-last? value)
- (&/T [meta ($variant idx is-last? (shift-function-body own-body? value))])
+ (&/T [meta ($variant idx is-last? (shift-function-body old-scope new-scope own-body? value))])
($tuple elems)
- (&/T [meta ($tuple (&/|map (partial shift-function-body own-body?) elems))])
+ (&/T [meta ($tuple (&/|map (partial shift-function-body old-scope new-scope own-body?) elems))])
($case value [_pm _bodies])
- (&/T [meta ($case (shift-function-body own-body? value)
+ (&/T [meta ($case (shift-function-body old-scope new-scope own-body? value)
(&/T [(if own-body?
(shift-pattern _pm)
_pm)
- (&/|map (partial shift-function-body own-body?) _bodies)]))])
+ (&/|map (partial shift-function-body old-scope new-scope own-body?) _bodies)]))])
($function arity scope captured body*)
- (&/T [meta ($function arity
- (de-scope scope)
- (&/|map (fn [capture]
- (|let [[_name [_meta ($captured _scope _idx _source)]] capture]
- (&/T [_name (&/T [_meta ($captured (de-scope _scope) _idx (shift-function-body own-body? _source))])])))
- captured)
- (shift-function-body false body*))])
+ (|let [scope* (de-scope old-scope new-scope scope)]
+ (&/T [meta ($function arity
+ scope*
+ (&/|map (fn [capture]
+ (|let [[_name [_meta ($captured _scope _idx _source)]] capture]
+ (&/T [_name (&/T [_meta ($captured scope* _idx (shift-function-body old-scope new-scope own-body? _source))])])))
+ captured)
+ (shift-function-body old-scope new-scope false body*))]))
($ann value-expr type-expr type-type)
- (&/T [meta ($ann (shift-function-body own-body? value-expr)
+ (&/T [meta ($ann (shift-function-body old-scope new-scope own-body? value-expr)
type-expr
type-type)])
@@ -276,13 +298,13 @@
(if own-body?
(&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))])
(&/$Cons (&/T [meta-0 ($var (&/$Local 1))])
- (&/|map (partial shift-function-body own-body?) args)))])
+ (&/|map (partial shift-function-body old-scope new-scope own-body?) args)))])
(&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))])
- (&/|map (partial shift-function-body own-body?) args))]))
+ (&/|map (partial shift-function-body old-scope new-scope own-body?) args))]))
($apply func args)
- (&/T [meta ($apply (shift-function-body own-body? func)
- (&/|map (partial shift-function-body own-body?) args))])
+ (&/T [meta ($apply (shift-function-body old-scope new-scope own-body? func)
+ (&/|map (partial shift-function-body old-scope new-scope own-body?) args))])
($captured scope idx source)
(if own-body?
@@ -292,13 +314,13 @@
source
_
- (&/T [meta ($captured (de-scope scope) idx (shift-function-body own-body? source))])))
+ (&/T [meta ($captured (de-scope old-scope new-scope scope) idx (shift-function-body old-scope new-scope own-body? source))])))
($proc proc-ident args special-args)
- (&/T [meta ($proc proc-ident (&/|map (partial shift-function-body own-body?) args) special-args)])
+ (&/T [meta ($proc proc-ident (&/|map (partial shift-function-body old-scope new-scope own-body?) args) special-args)])
($loop args)
- (&/T [meta ($loop (&/|map (partial shift-function-body own-body?) args))])
+ (&/T [meta ($loop (&/|map (partial shift-function-body old-scope new-scope own-body?) args))])
_
body
@@ -382,7 +404,7 @@
(&a/$lambda scope captured body)
(|case (pass-0 body)
[_ ($function _arity _scope _captured _body)]
- (&/T [meta ($function (inc _arity) scope (optimize-closure pass-0 captured) (shift-function-body true _body))])
+ (&/T [meta ($function (inc _arity) scope (optimize-closure pass-0 captured) (shift-function-body scope _scope true _body))])
=body
(&/T [meta ($function 1 scope (optimize-closure pass-0 captured) =body)]))