- The expected-type in the compiler-state is now a (Maybe Type), instead of a Type.

- Simplified and optimized the pattern-matching done during the analysis phase.
- Fixed the bug that caused the JVM garbage-collector to go crazy after running the compiler.

5 files changed, 184 insertions, 165 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 93092c9ac..cf2e4bab7 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -44,168 +44,156 @@
         ))
     ))
 
-(defn ^:private aba1 [analyse optimize eval! compile-module compilers exo-type token]
-  (|let [[compile-def compile-program compile-class compile-interface] compilers]
+(defn ^:private just-analyse [analyser syntax]
+  (&type/with-var
+    (fn [?var]
+      (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)]
+        (|case [?var ?output-type]
+          [(&/$VarT ?e-id) (&/$VarT ?a-id)]
+          (if (= ?e-id ?a-id)
+            (|do [=output-type (&type/clean ?var ?output-type)]
+              (return (&&/|meta =output-type ?output-cursor ?output-term)))
+            (|do [=output-type (&type/clean ?var ?var)]
+              (return (&&/|meta =output-type ?output-cursor ?output-term))))
+
+          [_ _]
+          (|do [=output-type (&type/clean ?var ?output-type)]
+            (return (&&/|meta =output-type ?output-cursor ?output-term))))
+        ))))
+
+(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type ?token]
+  (|let [analyse (partial analyse-ast optimize eval! compile-module compilers)
+         [cursor token] ?token
+         [compile-def compile-program compile-class compile-interface] compilers]
     (|case token
       ;; Standard special forms
       (&/$BoolS ?value)
-      (|do [_ (&type/check exo-type &type/Bool)
-            _cursor &/cursor]
-        (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value)))))
+      (|do [_ (&type/check exo-type &type/Bool)]
+        (return (&/|list (&&/|meta exo-type cursor (&&/$bool ?value)))))
 
       (&/$IntS ?value)
-      (|do [_ (&type/check exo-type &type/Int)
-            _cursor &/cursor]
-        (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value)))))
+      (|do [_ (&type/check exo-type &type/Int)]
+        (return (&/|list (&&/|meta exo-type cursor (&&/$int ?value)))))
 
       (&/$RealS ?value)
-      (|do [_ (&type/check exo-type &type/Real)
-            _cursor &/cursor]
-        (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value)))))
+      (|do [_ (&type/check exo-type &type/Real)]
+        (return (&/|list (&&/|meta exo-type cursor (&&/$real ?value)))))
 
       (&/$CharS ?value)
-      (|do [_ (&type/check exo-type &type/Char)
-            _cursor &/cursor]
-        (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value)))))
+      (|do [_ (&type/check exo-type &type/Char)]
+        (return (&/|list (&&/|meta exo-type cursor (&&/$char ?value)))))
 
       (&/$TextS ?value)
-      (|do [_ (&type/check exo-type &type/Text)
-            _cursor &/cursor]
-        (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value)))))
+      (|do [_ (&type/check exo-type &type/Text)]
+        (return (&/|list (&&/|meta exo-type cursor (&&/$text ?value)))))
 
       (&/$TupleS ?elems)
-      (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)
+      (&/with-analysis-meta cursor exo-type
+        (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems))
 
       (&/$RecordS ?elems)
-      (&&lux/analyse-record analyse exo-type ?elems)
+      (&/with-analysis-meta cursor exo-type
+        (&&lux/analyse-record analyse exo-type ?elems))
 
       (&/$TagS ?ident)
-      (analyse-variant+ analyse exo-type ?ident &/$Nil)
+      (&/with-analysis-meta cursor exo-type
+        (analyse-variant+ analyse exo-type ?ident &/$Nil))
 
       (&/$SymbolS ?ident)
-      (&&lux/analyse-symbol analyse exo-type ?ident)
+      (&/with-analysis-meta cursor exo-type
+        (&&lux/analyse-symbol analyse exo-type ?ident))
+
+      (&/$FormS (&/$Cons [command-meta command] parameters))
+      (|case command
+        (&/$SymbolS _ command-name)
+        (case command-name
+          "_lux_case"
+          (|let [(&/$Cons ?value ?branches) parameters]
+            (&/with-analysis-meta cursor exo-type
+              (&&lux/analyse-case analyse exo-type ?value ?branches)))
+
+          "_lux_lambda"
+          (|let [(&/$Cons [_ (&/$SymbolS "" ?self)]
+                          (&/$Cons [_ (&/$SymbolS "" ?arg)]
+                                   (&/$Cons ?body
+                                            (&/$Nil)))) parameters]
+            (&/with-analysis-meta cursor exo-type
+              (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)))
+
+          "_lux_proc"
+          (|let [(&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)]
+                                                 (&/$Cons [_ (&/$TextS ?proc)]
+                                                          (&/$Nil))))]
+                          (&/$Cons [_ (&/$TupleS ?args)]
+                                   (&/$Nil))) parameters]
+            (&/with-analysis-meta cursor exo-type
+              (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args)))
+
+          "_lux_:"
+          (|let [(&/$Cons ?type
+                          (&/$Cons ?value
+                                   (&/$Nil))) parameters]
+            (&/with-analysis-meta cursor exo-type
+              (&&lux/analyse-ann analyse eval! exo-type ?type ?value)))
+
+          "_lux_:!"
+          (|let [(&/$Cons ?type
+                          (&/$Cons ?value
+                                   (&/$Nil))) parameters]
+            (&/with-analysis-meta cursor exo-type
+              (&&lux/analyse-coerce analyse eval! exo-type ?type ?value)))
+
+          "_lux_def"
+          (|let [(&/$Cons [_ (&/$SymbolS "" ?name)]
+                          (&/$Cons ?value
+                                   (&/$Cons ?meta
+                                            (&/$Nil))
+                                   )) parameters]
+            (&/with-cursor cursor
+              (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta)))
+
+          "_lux_alias"
+          (|let [(&/$Cons [_ (&/$TextS ?alias)]
+                          (&/$Cons [_ (&/$TextS ?module)]
+                                   (&/$Nil))) parameters]
+            (&/with-cursor cursor
+              (&&lux/analyse-alias analyse ?alias ?module)))
+
+          "_lux_import"
+          (|let [(&/$Cons [_ (&/$TextS ?path)]
+                          (&/$Nil)) parameters]
+            (&/with-cursor cursor
+              (&&lux/analyse-import analyse compile-module ?path)))
+
+          "_lux_program"
+          (|let [(&/$Cons [_ (&/$SymbolS "" ?args)]
+                          (&/$Cons ?body
+                                   (&/$Nil))) parameters]
+            (&/with-cursor cursor
+              (&&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))))
+
+        (&/$IntS idx)
+        (&/with-analysis-meta cursor exo-type
+          (&&lux/analyse-variant analyse (&/$Right exo-type) idx nil parameters))
+
+        (&/$TagS ?ident)
+        (&/with-analysis-meta cursor exo-type
+          (analyse-variant+ analyse exo-type ?ident parameters))
 
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")]
-                         (&/$Cons ?value ?branches)))
-      (&&lux/analyse-case analyse exo-type ?value ?branches)
-      
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_lambda")]
-                         (&/$Cons [_ (&/$SymbolS "" ?self)]
-                                  (&/$Cons [_ (&/$SymbolS "" ?arg)]
-                                           (&/$Cons ?body
-                                                    (&/$Nil))))))
-      (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_def")]
-                         (&/$Cons [_ (&/$SymbolS "" ?name)]
-                                  (&/$Cons ?value
-                                           (&/$Cons ?meta
-                                                    (&/$Nil))
-                                           ))))
-      (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta)
-      
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_import")]
-                         (&/$Cons [_ (&/$TextS ?path)]
-                                  (&/$Nil))))
-      (&&lux/analyse-import analyse compile-module ?path)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:")]
-                         (&/$Cons ?type
-                                  (&/$Cons ?value
-                                           (&/$Nil)))))
-      (&&lux/analyse-ann analyse eval! exo-type ?type ?value)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:!")]
-                         (&/$Cons ?type
-                                  (&/$Cons ?value
-                                           (&/$Nil)))))
-      (&&lux/analyse-coerce analyse eval! exo-type ?type ?value)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_alias")]
-                         (&/$Cons [_ (&/$TextS ?alias)]
-                                  (&/$Cons [_ (&/$TextS ?module)]
-                                           (&/$Nil)))))
-      (&&lux/analyse-alias analyse ?alias ?module)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_proc")]
-                         (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)]
-                                                         (&/$Cons [_ (&/$TextS ?proc)]
-                                                                  (&/$Nil))))]
-                                  (&/$Cons [_ (&/$TupleS ?args)]
-                                           (&/$Nil)))))
-      (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args)
-
-      (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_program")]
-                         (&/$Cons [_ (&/$SymbolS "" ?args)]
-                                  (&/$Cons ?body
-                                           (&/$Nil)))))
-      (&&lux/analyse-program analyse optimize compile-program ?args ?body)
+        _
+        (&/with-analysis-meta cursor exo-type
+          (|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])))))
       )))
 
-(defn ^:private analyse-basic-ast [analyse optimize eval! compile-module compilers exo-type token]
-  (|case token
-    [meta ?token]
-    (fn [state]
-      (|case ((aba1 analyse optimize eval! compile-module compilers exo-type ?token) state)
-        (&/$Right state* output)
-        (return* state* output)
-
-        (&/$Left msg)
-        (if (= "" msg)
-          (fail* (&/add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token))))
-          (fail* (&/add-loc (&/get$ &/$cursor state) msg)))
-        ))))
-
-(defn ^:private just-analyse [analyser syntax]
-  (&type/with-var
-    (fn [?var]
-      (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)]
-        (|case [?var ?output-type]
-          [(&/$VarT ?e-id) (&/$VarT ?a-id)]
-          (if (= ?e-id ?a-id)
-            (|do [=output-type (&type/clean ?var ?output-type)]
-              (return (&&/|meta =output-type ?output-cursor ?output-term)))
-            (|do [=output-type (&type/clean ?var ?var)]
-              (return (&&/|meta =output-type ?output-cursor ?output-term))))
-
-          [_ _]
-          (|do [=output-type (&type/clean ?var ?output-type)]
-            (return (&&/|meta =output-type ?output-cursor ?output-term))))
-        ))))
-
-(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type token]
-  (|let [[cursor _] token
-         analyser (partial analyse-ast optimize eval! compile-module compilers)]
-    (&/with-cursor cursor
-      (&/with-expected-type exo-type
-        (|case token
-          [meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))]
-          (&&lux/analyse-variant analyser (&/$Right exo-type) idx nil ?values)
-
-          [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))]
-          (analyse-variant+ analyser exo-type ?ident ?values)
-          
-          [meta (&/$FormS (&/$Cons ?fn ?args))]
-          (|case ?fn
-            [_ (&/$SymbolS _)]
-            (fn [state]
-              (|case ((just-analyse analyser ?fn) state)
-                (&/$Right state* =fn)
-                ((&&lux/analyse-apply analyser exo-type =fn ?args) state*)
-
-                _
-                ((analyse-basic-ast analyser optimize eval! compile-module compilers exo-type token) state)))
-
-            _
-            (|do [=fn (just-analyse analyser ?fn)]
-              (&&lux/analyse-apply analyser exo-type =fn ?args)))
-          
-          _
-          (analyse-basic-ast analyser optimize eval! compile-module compilers exo-type token))))))
-
 ;; [Resources]
 (defn analyse [optimize eval! compile-module compilers]
   (|do [asts &parser/parse]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 843f61d34..1a3634f8f 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -371,7 +371,7 @@
                                (&&/$apply =fn =args)
                                )))))
 
-(defn analyse-apply [analyse exo-type =fn ?args]
+(defn analyse-apply [analyse cursor exo-type =fn ?args]
   (|do [loader &/loader
         :let [[[=fn-type =fn-cursor] =fn-form] =fn]]
     (|case =fn-form
@@ -544,7 +544,8 @@
     (return (&/|list output))))
 
 (defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta]
-  (|do [module-name &/get-module-name
+  (|do [;; _ &/ensure-statement
+        module-name &/get-module-name
         ? (&&module/defined? module-name ?name)]
     (if ?
       (fail (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
@@ -559,7 +560,8 @@
       )))
 
 (defn analyse-import [analyse compile-module path]
-  (|do [module-name &/get-module-name
+  (|do [;; _ &/ensure-statement
+        module-name &/get-module-name
         _ (if (= module-name path)
             (fail (str "[Analyser Error] Module can't import itself: " path))
             (return nil))]
@@ -574,7 +576,8 @@
        (return &/$Nil)))))
 
 (defn analyse-alias [analyse ex-alias ex-module]
-  (|do [module-name &/get-module-name
+  (|do [;; _ &/ensure-statement
+        module-name &/get-module-name
         _ (&&module/alias module-name ex-alias ex-module)]
     (return &/$Nil)))
 
@@ -614,7 +617,8 @@
 (let [input-type (&/$AppT &type/List &type/Text)
       output-type (&/$AppT &type/IO &/$UnitT)]
   (defn analyse-program [analyse optimize compile-program ?args ?body]
-    (|do [=body (&/with-scope ""
+    (|do [;; _ &/ensure-statement
+          =body (&/with-scope ""
                   (&&env/with-local ?args input-type
                     (&&/analyse-1 analyse output-type ?body)))
           _ (compile-program (optimize =body))]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 89f9bb36a..54baf16bb 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -761,7 +761,7 @@
       ;; "lux;types"
       +init-bindings+
       ;; "lux;expected"
-      $VoidT
+      $None
       ;; "lux;seed"
       0
       ;; "lux;host"
@@ -902,7 +902,7 @@
 (defn with-expected-type [type body]
   "(All [a] (-> Type (Lux a)))"
   (fn [state]
-    (let [output (body (set$ $expected type state))]
+    (let [output (body (set$ $expected ($Some type) state))]
       (|case output
         ($Right ?state ?value)
         (return* (set$ $expected (get$ $expected state) ?state)
@@ -913,7 +913,7 @@
 
 (defn with-cursor [^objects cursor body]
   "(All [a] (-> Cursor (Lux a)))"
-  (|let [[_file-name _line _column] cursor]
+  (|let [[_file-name _ _] cursor]
     (if (= "" _file-name)
       body
       (fn [state]
@@ -926,6 +926,45 @@
             _
             output))))))
 
+(defn with-analysis-meta [^objects cursor type body]
+  "(All [a] (-> Cursor Type (Lux a)))"
+  (|let [[_file-name _ _] cursor]
+    (if (= "" _file-name)
+      (fn [state]
+        (let [output (body (->> state
+                                (set$ $expected ($Some type))))]
+          (|case output
+            ($Right ?state ?value)
+            (return* (->> ?state
+                          (set$ $expected (get$ $expected state)))
+                     ?value)
+
+            _
+            output)))
+      (fn [state]
+        (let [output (body (->> state
+                                (set$ $cursor cursor)
+                                (set$ $expected ($Some type))))]
+          (|case output
+            ($Right ?state ?value)
+            (return* (->> ?state
+                          (set$ $cursor (get$ $cursor state))
+                          (set$ $expected (get$ $expected state)))
+                     ?value)
+
+            _
+            output))))))
+
+(def ensure-statement
+  "(Lux Unit)"
+  (fn [state]
+    (|case (get$ $expected state)
+      ($None)
+      (return* state unit-tag)
+
+      ($Some _)
+      (fail* "[Error] All statements must be top-level forms."))))
+
 (def cursor
   ;; (Lux Cursor)
   (fn [state]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index fe256a942..27bb42e4f 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -40,7 +40,7 @@
 (def ^:private !source->last-line (atom nil))
 
 (defn compile-expression [syntax]
-  (|let [[[?type [_file-name _line _column]] ?form] syntax]
+  (|let [[[?type [_file-name _line _]] ?form] syntax]
     (|do [^MethodVisitor *writer* &/get-writer
           :let [debug-label (new Label)
                 _ (when (not= _line (get @!source->last-line _file-name))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 2bc0c29eb..7ba93a32b 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -170,19 +170,14 @@
           $end (new Label)
           method-writer (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature +degree+) nil nil)
           frame-locals (to-array (list class-name "java/lang/Object" "java/lang/Object"))
-          frame-stack (to-array [Opcodes/INTEGER])]
+          frame-stack (to-array [Opcodes/INTEGER])
+          arity-over-extent (- arity +degree+)]
       (do (doto method-writer
             (.visitCode)
             get-num-partials!
-            (.visitFrame Opcodes/F_NEW
-                         (int (alength frame-locals)) frame-locals
-                         (int (alength frame-stack))  frame-stack)
             (.visitTableSwitchInsn 0 (dec num-partials) $default (into-array Label $labels*))
             ;; (< stage (- arity +degree+))
             (-> (doto (.visitLabel $label)
-                  (.visitFrame Opcodes/F_NEW
-                               (int (alength frame-locals)) frame-locals
-                               (int (alength frame-stack))  frame-stack)
                   (.visitTypeInsn Opcodes/NEW class-name)
                   (.visitInsn Opcodes/DUP)
                   (-> (get-field! class-name (str &&/closure-prefix cidx))
@@ -195,12 +190,9 @@
                   (fill-nulls! (- (- num-partials +degree+) stage))
                   (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env arity))
                   (.visitJumpInsn Opcodes/GOTO $end))
-                (->> (cond (= stage (- arity +degree+))
+                (->> (cond (= stage arity-over-extent)
                            (doto method-writer
                              (.visitLabel $label)
-                             (.visitFrame Opcodes/F_NEW
-                                          (int (alength frame-locals)) frame-locals
-                                          (int (alength frame-stack))  frame-stack)
                              (.visitVarInsn Opcodes/ALOAD 0)
                              (-> (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "reset" (reset-signature class-name))
                                  (->> (when (not= 0 stage))))
@@ -210,22 +202,18 @@
                              (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature arity))
                              (.visitJumpInsn Opcodes/GOTO $end))
 
-                           (> stage (- arity +degree+))
-                           (let [base 1
-                                 args-to-completion (- arity stage)
+                           (> stage arity-over-extent)
+                           (let [args-to-completion (- arity stage)
                                  args-left (- +degree+ args-to-completion)]
                              (doto method-writer
                                (.visitLabel $label)
-                               (.visitFrame Opcodes/F_NEW
-                                            (int (alength frame-locals)) frame-locals
-                                            (int (alength frame-stack))  frame-stack)
                                (.visitVarInsn Opcodes/ALOAD 0)
                                (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "reset" (reset-signature class-name))
                                (-> (get-field! class-name (str &&/partial-prefix idx))
                                    (->> (dotimes [idx stage])))
-                               (consecutive-args base args-to-completion)
+                               (consecutive-args 1 args-to-completion)
                                (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature arity))
-                               (consecutive-applys (+ base args-to-completion) args-left)
+                               (consecutive-applys (+ 1 args-to-completion) args-left)
                                (.visitJumpInsn Opcodes/GOTO $end)))
 
                            :else)