diff options
Diffstat (limited to 'src/lux/optimizer.clj')
| -rw-r--r-- | src/lux/optimizer.clj | 158 |
1 files changed, 101 insertions, 57 deletions
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 9b4dd7548..920fd21bc 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -2,7 +2,6 @@ ;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. ;; If a copy of the MPL was not distributed with this file, ;; You can obtain one at http://mozilla.org/MPL/2.0/. - (ns lux.optimizer (:require (lux [base :as & :refer [|let |do return fail return* fail* |case defvariant]] [analyser :as &analyser]) @@ -25,6 +24,9 @@ ("var" 1) ("captured" 3) ("proc" 3) + + ;; Purely for optimizations + ("loop" 1) ) ;; [Utils] @@ -131,72 +133,114 @@ ($proc proc-ident args special-args) (&/T [meta ($proc proc-ident (&/|map (partial shift-function-body own-body?) args) special-args)]) + ($loop args) + (&/T [meta ($loop (&/|map (partial shift-function-body own-body?) args))]) + _ body ))) -(defn ^:private optimize-closure [optimize closure] - (&/|map (fn [capture] - (|let [[_name _analysis] capture] - (&/T [_name (optimize _analysis)]))) - closure)) +(defn ^:private optimize-loop [arity optim] + "(-> Int Optimized [Optimized Bool])" + (|let [[meta optim-] optim] + (|case optim- + ($apply [meta-0 ($var (&/$Local 0))] _args) + (if (= arity (&/|length _args)) + (&/T [meta-0 ($loop (&/|map (partial optimize-loop -1) _args))]) + optim) -;; [Exports] -(defn optimize [analysis] - "(-> Analysis Optimized)" - (|let [[meta analysis-] analysis] - (|case analysis- - (&-base/$bool value) - (&/T [meta ($bool value)]) - - (&-base/$int value) - (&/T [meta ($int value)]) - - (&-base/$real value) - (&/T [meta ($real value)]) - - (&-base/$char value) - (&/T [meta ($char value)]) - - (&-base/$text value) - (&/T [meta ($text value)]) - - (&-base/$variant idx is-last? value) - (&/T [meta ($variant idx is-last? (optimize value))]) - - (&-base/$tuple elems) - (&/T [meta ($tuple (&/|map optimize elems))]) - - (&-base/$apply func args) - (&/T [meta ($apply (optimize func) (&/|map optimize args))]) - - (&-base/$case value branches) - (&/T [meta ($case (optimize value) + ($apply func args) + (&/T [meta ($apply (optimize-loop -1 func) + (&/|map (partial optimize-loop -1) args))]) + + ($case _value _branches) + (&/T [meta ($case _value (&/|map (fn [branch] (|let [[_pattern _body] branch] - (&/T [_pattern (optimize _body)]))) - branches))]) - - (&-base/$lambda scope captured body) - (|case (optimize body) - [_ ($function _arity _scope _captured _body)] - (&/T [meta ($function (inc _arity) scope (optimize-closure optimize captured) (shift-function-body true _body))]) + (&/T [_pattern (optimize-loop arity _body)]))) + _branches))]) - =body - (&/T [meta ($function 1 scope (optimize-closure optimize captured) =body)])) + ($function _arity _scope _captured _body) + (&/T [meta ($function _arity _scope _captured (optimize-loop _arity _body))]) - (&-base/$ann value-expr type-expr type-type) - (&/T [meta ($ann (optimize value-expr) type-expr type-type)]) - - (&-base/$var var-kind) - (&/T [meta ($var var-kind)]) - - (&-base/$captured scope idx source) - (&/T [meta ($captured scope idx (optimize source))]) + ($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))]) - (&-base/$proc proc-ident args special-args) - (&/T [meta ($proc proc-ident (&/|map optimize args) special-args)]) + ($tuple elems) + (&/T [meta ($tuple (&/|map (partial optimize-loop -1) elems))]) _ - (assert false (prn-str 'optimize (&/adt->text analysis))) + optim ))) + +(let [optimize-closure (fn [optimize closure] + (&/|map (fn [capture] + (|let [[_name _analysis] capture] + (&/T [_name (optimize _analysis)]))) + closure))] + (defn ^:private pass-0 [analysis] + "(-> Analysis Optimized)" + (|let [[meta analysis-] analysis] + (|case analysis- + (&-base/$bool value) + (&/T [meta ($bool value)]) + + (&-base/$int value) + (&/T [meta ($int value)]) + + (&-base/$real value) + (&/T [meta ($real value)]) + + (&-base/$char value) + (&/T [meta ($char value)]) + + (&-base/$text value) + (&/T [meta ($text value)]) + + (&-base/$variant idx is-last? value) + (&/T [meta ($variant idx is-last? (pass-0 value))]) + + (&-base/$tuple elems) + (&/T [meta ($tuple (&/|map pass-0 elems))]) + + (&-base/$apply func args) + (&/T [meta ($apply (pass-0 func) (&/|map pass-0 args))]) + + (&-base/$case value branches) + (&/T [meta ($case (pass-0 value) + (&/|map (fn [branch] + (|let [[_pattern _body] branch] + (&/T [_pattern (pass-0 _body)]))) + branches))]) + + (&-base/$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))]) + + =body + (&/T [meta ($function 1 scope (optimize-closure pass-0 captured) =body)])) + + (&-base/$ann value-expr type-expr type-type) + (&/T [meta ($ann (pass-0 value-expr) type-expr type-type)]) + + (&-base/$var var-kind) + (&/T [meta ($var var-kind)]) + + (&-base/$captured scope idx source) + (&/T [meta ($captured scope idx (pass-0 source))]) + + (&-base/$proc proc-ident args special-args) + (&/T [meta ($proc proc-ident (&/|map pass-0 args) special-args)]) + + _ + (assert false (prn-str 'pass-0 (&/adt->text analysis))) + )))) + +;; [Exports] +(defn optimize [analysis] + "(-> Analysis Optimized)" + (->> analysis pass-0 (optimize-loop -1))) |