- 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.

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)))
+      )))