aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2016-05-13 23:10:20 -0400
committerEduardo Julian2016-05-13 23:10:20 -0400
commitf112989822f9ece0485ff8f5eb8df671655929b8 (patch)
tree9ea7ae73d461b959f1331a97ccd862a00f1ad0c1 /src
parent4e777e8397840f334f211d4c82d52215eea80083 (diff)
- Optimized pattern-matching on the analyser-phase.
- Analysis of statements now ensures they are top-level forms, by making sure there is no expected type when they are analyzed.
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj10
-rw-r--r--src/lux/analyser/base.clj3
-rw-r--r--src/lux/analyser/lux.clj17
-rw-r--r--src/lux/optimizer.clj282
4 files changed, 135 insertions, 177 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index cf2e4bab7..73d89e036 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -173,9 +173,8 @@
(&&lux/analyse-program analyse optimize compile-program ?args ?body)))
;; else
- (&/with-analysis-meta cursor exo-type
- (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
- (&&lux/analyse-apply analyse cursor exo-type =fn parameters))))
+ (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
+ (&&lux/analyse-apply analyse cursor exo-type =fn parameters)))
(&/$IntS idx)
(&/with-analysis-meta cursor exo-type
@@ -186,9 +185,8 @@
(analyse-variant+ analyse exo-type ?ident parameters))
_
- (&/with-analysis-meta cursor exo-type
- (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
- (&&lux/analyse-apply analyse cursor exo-type =fn parameters))))
+ (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
+ (&&lux/analyse-apply analyse cursor exo-type =fn parameters)))
_
(&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index aa2f27a68..6e36967e1 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -57,7 +57,8 @@
(fail "[Analyser Error] Can't expand to other than 1 element."))))
(defn analyse-1 [analyse exo-type elem]
- (cap-1 (analyse exo-type elem)))
+ (&/with-expected-type exo-type
+ (cap-1 (analyse exo-type elem))))
(defn analyse-1+ [analyse ?token]
(&type/with-var
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 1a3634f8f..0bfa647e5 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -399,10 +399,12 @@
(&/flat-map% (partial analyse exo-type) macro-expansion))
_
- (do-analyse-apply analyse exo-type =fn ?args)))
+ (&/with-analysis-meta cursor exo-type
+ (do-analyse-apply analyse exo-type =fn ?args))))
_
- (do-analyse-apply analyse exo-type =fn ?args))
+ (&/with-analysis-meta cursor exo-type
+ (do-analyse-apply analyse exo-type =fn ?args)))
))
(defn analyse-case [analyse exo-type ?value ?branches]
@@ -544,7 +546,7 @@
(return (&/|list output))))
(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta]
- (|do [;; _ &/ensure-statement
+ (|do [_ &/ensure-statement
module-name &/get-module-name
? (&&module/defined? module-name ?name)]
(if ?
@@ -560,7 +562,7 @@
)))
(defn analyse-import [analyse compile-module path]
- (|do [;; _ &/ensure-statement
+ (|do [_ &/ensure-statement
module-name &/get-module-name
_ (if (= module-name path)
(fail (str "[Analyser Error] Module can't import itself: " path))
@@ -576,7 +578,7 @@
(return &/$Nil)))))
(defn analyse-alias [analyse ex-alias ex-module]
- (|do [;; _ &/ensure-statement
+ (|do [_ &/ensure-statement
module-name &/get-module-name
_ (&&module/alias module-name ex-alias ex-module)]
(return &/$Nil)))
@@ -591,7 +593,8 @@
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
_ (&type/check exo-type ==type)
- =value (&&/analyse-1 analyse ==type ?value)
+ =value (&/with-expected-type ==type
+ (&&/analyse-1 analyse ==type ?value))
_cursor &/cursor
;; =value (&&/analyse-1 analyse ==type ?value)
;; :let [_ (prn 0 (&/adt->text =value))
@@ -617,7 +620,7 @@
(let [input-type (&/$AppT &type/List &type/Text)
output-type (&/$AppT &type/IO &/$UnitT)]
(defn analyse-program [analyse optimize compile-program ?args ?body]
- (|do [;; _ &/ensure-statement
+ (|do [_ &/ensure-statement
=body (&/with-scope ""
(&&env/with-local ?args input-type
(&&/analyse-1 analyse output-type ?body)))
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 09f23886e..6adfca501 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -57,120 +57,75 @@
(&/$Cons _module (&/$Cons _def (&/$Cons _level-to-remove _levels-to-keep)))
(&/$Cons _module (&/$Cons _def _levels-to-keep))))
-(defn ^:private de-meta [body]
- "(-> Optimized Optimized)"
- (|case body
- [meta ($variant idx is-last? value)]
- ($variant idx is-last? (de-meta value))
-
- [meta ($tuple elems)]
- ($tuple (&/|map de-meta elems))
-
- [meta ($apply func args)]
- ($apply (de-meta func)
- (&/|map de-meta args))
-
- [meta ($case value branches)]
- ($case (de-meta value)
- (&/|map (fn [branch]
- (|let [[_pattern _body] branch]
- (&/T [_pattern (de-meta _body)])))
- branches))
-
- [meta ($function arity scope captured body*)]
- ($function arity
- scope
- (&/|map (fn [capture]
- (|let [[_name _captured] capture]
- (&/T [_name (de-meta _captured)]))
- )
- captured)
- (de-meta body*))
-
- [meta ($ann value-expr type-expr type-type)]
- ($ann (de-meta value-expr) nil nil)
-
- [meta ($var var-kind)]
- ($var var-kind)
-
- [meta ($captured scope idx source)]
- ($captured scope idx (de-meta source))
-
- [meta ($proc proc-ident args special-args)]
- (&/T ($proc proc-ident (&/|map de-meta args) special-args))
-
- [meta not-interesting]
- not-interesting
- ))
-
(defn ^:private shift-function-body [own-body? body]
"(-> Optimized Optimized)"
- (|case body
- [meta ($variant idx is-last? value)]
- (&/T [meta ($variant idx is-last? (shift-function-body own-body? value))])
-
- [meta ($tuple elems)]
- (&/T [meta ($tuple (&/|map (partial shift-function-body own-body?) elems))])
-
- [meta ($apply func args)]
- (&/T [meta ($apply (shift-function-body own-body? func)
- (&/|map (partial shift-function-body own-body?) args))])
-
- [meta ($case value branches)]
- (&/T [meta ($case (shift-function-body own-body? value)
- (&/|map (fn [branch]
- (|let [[_pattern _body] branch]
- (&/T [(if own-body?
- (shift-pattern _pattern)
- _pattern)
- (shift-function-body own-body? _body)])))
- branches))])
-
- [meta ($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*))])
-
- [meta ($ann value-expr type-expr type-type)]
- (&/T [meta ($ann (shift-function-body own-body? value-expr)
- type-expr
- type-type)])
-
- [meta ($var var-kind)]
- (if own-body?
- (|case var-kind
- (&/$Local 0)
- (&/T [meta ($apply body
- (&/|list [meta ($var (&/$Local 1))]))])
-
- (&/$Local idx)
- (&/T [meta ($var (&/$Local (inc idx)))])
-
- (&/$Global ?module ?name)
+ (|let [[meta body-] body]
+ (|case body-
+ ($variant idx is-last? value)
+ (&/T [meta ($variant idx is-last? (shift-function-body own-body? value))])
+
+ ($tuple elems)
+ (&/T [meta ($tuple (&/|map (partial shift-function-body own-body?) elems))])
+
+ ($apply func args)
+ (&/T [meta ($apply (shift-function-body own-body? func)
+ (&/|map (partial shift-function-body own-body?) args))])
+
+ ($case value branches)
+ (&/T [meta ($case (shift-function-body own-body? value)
+ (&/|map (fn [branch]
+ (|let [[_pattern _body] branch]
+ (&/T [(if own-body?
+ (shift-pattern _pattern)
+ _pattern)
+ (shift-function-body own-body? _body)])))
+ branches))])
+
+ ($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*))])
+
+ ($ann value-expr type-expr type-type)
+ (&/T [meta ($ann (shift-function-body own-body? value-expr)
+ type-expr
+ type-type)])
+
+ ($var var-kind)
+ (if own-body?
+ (|case var-kind
+ (&/$Local 0)
+ (&/T [meta ($apply body
+ (&/|list [meta ($var (&/$Local 1))]))])
+
+ (&/$Local idx)
+ (&/T [meta ($var (&/$Local (inc idx)))])
+
+ (&/$Global ?module ?name)
+ body)
body)
- body)
-
- [meta ($captured scope idx source)]
- (if own-body?
- source
- (|case scope
- (&/$Cons _ (&/$Cons _ (&/$Nil)))
+
+ ($captured scope idx source)
+ (if own-body?
source
+ (|case scope
+ (&/$Cons _ (&/$Cons _ (&/$Nil)))
+ source
- _
- (&/T [meta ($captured (de-scope scope) idx (shift-function-body own-body? source))]))
- )
-
- [meta ($proc proc-ident args special-args)]
- (&/T [meta ($proc proc-ident (&/|map (partial shift-function-body own-body?) args) special-args)])
+ _
+ (&/T [meta ($captured (de-scope scope) idx (shift-function-body own-body? source))]))
+ )
+
+ ($proc proc-ident args special-args)
+ (&/T [meta ($proc proc-ident (&/|map (partial shift-function-body own-body?) args) special-args)])
- not-interesting
- not-interesting
- ))
+ _
+ body
+ )))
(defn ^:private optimize-closure [optimize closure]
(&/|map (fn [capture]
@@ -181,58 +136,59 @@
;; [Exports]
(defn optimize [analysis]
"(-> Analysis Optimized)"
- (|case analysis
- [meta (&-base/$bool value)]
- (&/T [meta ($bool value)])
-
- [meta (&-base/$int value)]
- (&/T [meta ($int value)])
-
- [meta (&-base/$real value)]
- (&/T [meta ($real value)])
-
- [meta (&-base/$char value)]
- (&/T [meta ($char value)])
-
- [meta (&-base/$text value)]
- (&/T [meta ($text value)])
-
- [meta (&-base/$variant idx is-last? value)]
- (&/T [meta ($variant idx is-last? (optimize value))])
-
- [meta (&-base/$tuple elems)]
- (&/T [meta ($tuple (&/|map optimize elems))])
-
- [meta (&-base/$apply func args)]
- (&/T [meta ($apply (optimize func) (&/|map optimize args))])
-
- [meta (&-base/$case value branches)]
- (&/T [meta ($case (optimize value)
- (&/|map (fn [branch]
- (|let [[_pattern _body] branch]
- (&/T [_pattern (optimize _body)])))
- branches))])
-
- [meta (&-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))])
-
- =body
- (&/T [meta ($function 1 scope (optimize-closure optimize captured) =body)]))
-
- [meta (&-base/$ann value-expr type-expr type-type)]
- (&/T [meta ($ann (optimize value-expr) type-expr type-type)])
-
- [meta (&-base/$var var-kind)]
- (&/T [meta ($var var-kind)])
-
- [meta (&-base/$captured scope idx source)]
- (&/T [meta ($captured scope idx (optimize source))])
-
- [meta (&-base/$proc proc-ident args special-args)]
- (&/T [meta ($proc proc-ident (&/|map optimize args) special-args)])
-
- _
- (assert false (prn-str 'optimize (&/adt->text analysis)))
- ))
+ (|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)
+ (&/|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))])
+
+ =body
+ (&/T [meta ($function 1 scope (optimize-closure optimize captured) =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))])
+
+ (&-base/$proc proc-ident args special-args)
+ (&/T [meta ($proc proc-ident (&/|map optimize args) special-args)])
+
+ _
+ (assert false (prn-str 'optimize (&/adt->text analysis)))
+ )))