- declare-macro has returned.

- Method-invocation special forms now take the wanted method as an unprefixed symbol, instead of as text.
- Some fixes in lux.analyser.host.
- Lambda analysis now just returns the origin exo-type instead of the endo-type.
- Made some changes to the type of the CompilerState.

7 files changed, 157 insertions, 67 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index e4511fdeb..938f6df2f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -90,6 +90,11 @@
         ;;   (prn "if" (&/show-ast ?value)))
         (&&lux/analyse-def analyse ?name ?value))
 
+    [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "declare-macro'"]]]]
+                                                ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]]
+                                                             ["lux;Nil" _]]]]]]]]]
+    (&&lux/analyse-declare-macro analyse ?name)
+
     [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "import'"]]]]
                                                 ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]]
                                                              ["lux;Nil" _]]]]]]]]]
@@ -256,7 +261,7 @@
 
     [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokestatic"]]]]
                                                 ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
-                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
                                                                           ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
                                                                                        ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
                                                                                                     ["lux;Nil" _]]]]]]]]]]]]]]]
@@ -264,7 +269,7 @@
 
     [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokevirtual"]]]]
                                                 ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
-                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
                                                                           ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
                                                                                        ["lux;Cons" [?object
                                                                                                     ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
@@ -272,8 +277,8 @@
     (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
 
     [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokeinterface"]]]]
-                                                ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
-                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+                                                ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
                                                                           ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
                                                                                        ["lux;Cons" [?object
                                                                                                     ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
@@ -282,7 +287,7 @@
 
     [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokespecial"]]]]
                                                 ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
-                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+                                                             ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
                                                                           ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
                                                                                        ["lux;Cons" [?object
                                                                                                     ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 7d9aaae2f..466058f4e 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -2,7 +2,7 @@
   (:require (clojure [template :refer [do-template]])
             [clojure.core.match :as M :refer [match matchv]]
             clojure.core.match.array
-            (lux [base :as & :refer [|do return fail]]
+            (lux [base :as & :refer [|let |do return fail]]
                  [parser :as &parser]
                  [type :as &type]
                  [host :as &host])
@@ -102,16 +102,19 @@
 
 (do-template [<name> <tag>]
   (defn <name> [analyse ?class ?method ?classes ?object ?args]
-    ;; (prn '<name> ?class ?method)
+    (prn '<name> ?class ?method)
     (|do [=class (&host/full-class-name ?class)
           ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
           =classes (&/map% &host/extract-jvm-param ?classes)
           ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
           =return (&host/lookup-virtual-method =class ?method =classes)
           ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
-          =object (&&/analyse-1 analyse ?object)
+          =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
           ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
-          =args (&/flat-map% analyse ?args)
+          =args (&/map% (fn [c+o]
+                          (|let [[?c ?o] c+o]
+                            (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)))
+                        (&/zip2 =classes ?args))
           ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
           ]
       (return (&/|list (&/V "Expression" (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return))))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index b9a3ffbf2..7c9b9b5f0 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -38,6 +38,12 @@
         (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems)
                                                 exo-type)))))
 
+      [["lux;AllT" _]]
+      (&type/with-var
+        (fn [$var]
+          (|do [exo-type** (&type/apply-type exo-type* $var)]
+            (analyse-tuple analyse exo-type** ?elems))))
+
       [_]
       (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*))))))
 
@@ -315,13 +321,39 @@
               (if ?
                 (|do [dtype (&type/deref ?id)]
                   (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
-                (return output)))))))
+                (matchv ::M/objects [output]
+                  [["Expression" [_expr _]]]
+                  ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
+                  ;;   (return (&/V "Expression" (&/T _expr exo-type))))
+                  (return (&/V "Expression" (&/T _expr exo-type)))
+                  )))))))
     
     [_]
     (|do [exo-type* (&type/actual-type exo-type)]
       (analyse-lambda* analyse exo-type* ?self ?arg ?body))
     ))
 
+;; (defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
+;;   ;; (prn 'analyse-lambda**/&& (aget exo-type 0))
+;;   (matchv ::M/objects [exo-type]
+;;     [["lux;AllT" [_env _self _arg _body]]]
+;;     (&type/with-var
+;;       (fn [$var]
+;;         (|do [exo-type* (&type/apply-type exo-type $var)
+;;               output (analyse-lambda** analyse exo-type* ?self ?arg ?body)]
+;;           (matchv ::M/objects [$var]
+;;             [["lux;VarT" ?id]]
+;;             (|do [? (&type/bound? ?id)]
+;;               (if ?
+;;                 (|do [dtype (&type/deref ?id)]
+;;                   (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
+;;                 (return output)))))))
+    
+;;     [_]
+;;     (|do [exo-type* (&type/actual-type exo-type)]
+;;       (analyse-lambda* analyse exo-type* ?self ?arg ?body))
+;;     ))
+
 (defn analyse-lambda [analyse exo-type ?self ?arg ?body]
   (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)]
     (return (&/|list output))))
@@ -341,10 +373,7 @@
             :let [_ (prn 'analyse-def/TYPE ?name ;; (&type/show-type =value-type)
                          )
                   _ (println)
-                  def-data (cond (&type/type= &type/Macro =value-type)
-                                 (&/V "lux;MacroD" (&/V "lux;None" nil))
-
-                                 (&type/type= &type/Type =value-type)
+                  def-data (cond (&type/type= &type/Type =value-type)
                                  (&/V "lux;TypeD" nil)
                                  
                                  :else
@@ -354,6 +383,11 @@
             ]
         (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value def-data)))))))))
 
+(defn analyse-declare-macro [analyse ?name]
+  (|do [module-name &/get-module-name
+        _ (&&module/declare-macro module-name ?name)]
+    (return (&/|list))))
+
 (defn analyse-import [analyse exo-type ?path]
   (return (&/|list)))
 
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index ac5968026..6f82d9b6f 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -2,7 +2,8 @@
   (:require [clojure.core.match :as M :refer [matchv]]
             clojure.core.match.array
             (lux [base :as & :refer [|do return return* fail fail*]]
-                 [type :as &type])
+                 [type :as &type]
+                 [host :as &host])
             [lux.analyser.base :as &&]))
 
 ;; [Exports]
@@ -54,6 +55,35 @@
                          (return true))
                        (return false))))
 
+(defn declare-macro [module name]
+  (fn [state]
+    (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+      (if-let [$def (&/|get name $module)]
+        (matchv ::M/objects [$def]
+          [["lux;ValueD" ?type]]
+          (do ;; (prn 'declare-macro/?type (aget ?type 0))
+            (&/run-state (|do [_ (&type/check &type/Macro ?type)
+                               loader &/loader
+                               :let [macro (-> (.loadClass loader (&host/location (&/|list module name)))
+                                               (.getField "_datum")
+                                               (.get nil))]]
+                           (fn [state*]
+                             (return* (&/update$ &/$MODULES
+                                                 (fn [$modules]
+                                                   (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module)
+                                                           $modules))
+                                                 state*)
+                                      nil)))
+                         state))
+          
+          [["lux;MacroD" _]]
+          (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
+
+          [["lux;TypeD" _]]
+          (fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name)))
+        (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
+      (fail* (str "[Analyser Error] Module doesn't exist: " module)))))
+
 (defn install-macro [module name macro]
   (fn [state]
     (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 5ceeca1bc..1553d3975 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -163,16 +163,5 @@
         ;; :let [_ (prn 'compile-def/_1 ?name current-class)]
         _ (&&/save-class! current-class (.toByteArray =class))
         ;; :let [_ (prn 'compile-def/_2 ?name)]
-        loader &/loader
-        :let [full-macro-name (&host/location (&/|list module-name ?name))]
-        _ (if-let [macro (matchv ::M/objects [?def-data]
-                           [["lux;MacroD" ["lux;None" _]]]
-                           (-> (.loadClass loader full-macro-name)
-                               (.getField "_datum")
-                               (.get nil))
-                           
-                           [_]
-                           nil)]
-            (&a-module/install-macro module-name ?name macro)
-            (return nil))]
+        ]
     (return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 5b02c8192..26a270199 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -4,7 +4,6 @@
             [clojure.core.match :as M :refer [match matchv]]
             clojure.core.match.array
             (lux [base :as & :refer [|do return* return fail fail* |let]]
-                 [parser :as &parser]
                  [type :as &type])))
 
 ;; [Constants]
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e5c96d7bd..217a167a4 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -76,28 +76,6 @@
               (&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
                                                                                       (&/V "lux;BoundT" "v")))))))))
 
-(def Reader
-  (&/V "lux;AppT" (&/T List
-                       (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor))
-                                            Text)))))
-
-(def HostState
-  (&/V "lux;RecordT"
-       (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter"))
-                (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader"))
-                (&/T "lux;eval-ctor" Int))))
-
-(def CompilerState
-  (&/V "lux;RecordT"
-       (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader)))
-                (&/T "lux;modules" (&/V "lux;AppT" (&/T List $Void)))
-                (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
-                (&/T "lux;envs" (&/V "lux;AppT" (&/T List
-                                                     (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
-                                                                          $Void)))))
-                (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
-                (&/T "lux;host" HostState))))
-
 (def Syntax*
   (let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
                                      (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'")
@@ -121,20 +99,64 @@
   (let [w (&/V "lux;AppT" (&/T Meta Cursor))]
     (&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T Syntax* w))))))
 
+(def ^:private SyntaxList (&/V "lux;AppT" (&/T List Syntax)))
+
 (def Either
   (fAll "_" "l"
         (fAll "" "r"
               (&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l"))
                                            (&/T "lux;Right" (&/V "lux;BoundT" "r")))))))
 
+(def StateE
+  (fAll "StateE" "s"
+        (fAll "" "a"
+              (&/V "lux;LambdaT" (&/T (&/V "lux;BoundT" "s")
+                                      (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
+                                                           (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "s")
+                                                                                      (&/V "lux;BoundT" "a"))))))))))
+
+(def Reader
+  (&/V "lux;AppT" (&/T List
+                       (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor))
+                                            Text)))))
+
+(def HostState
+  (&/V "lux;RecordT"
+       (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter"))
+                (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader"))
+                (&/T "lux;eval-ctor" Int))))
+
+(def DefData*
+  (fAll "DefData'" ""
+        (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
+                                     (&/T "lux;ValueD" Type)
+                                     (&/T "lux;MacroD" (&/V "lux;BoundT" ""))))))
+
+(def CompilerState
+  (&/V "lux;AppT" (&/T (fAll "CompilerState" ""
+                             (&/V "lux;RecordT"
+                                  (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader)))
+                                           (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+                                                                                             (&/|list Text
+                                                                                                      (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+                                                                                                                                     (&/|list Text
+                                                                                                                                              (&/V "lux;AppT" (&/T DefData*
+                                                                                                                                                                   (&/V "lux;LambdaT" (&/T SyntaxList
+                                                                                                                                                                                           (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "CompilerState")
+                                                                                                                                                                                                                                                                 (&/V "lux;BoundT" "")))))
+                                                                                                                                                                                                                SyntaxList)))))))))))))))
+                                           (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
+                                           (&/T "lux;envs" (&/V "lux;AppT" (&/T List
+                                                                                (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
+                                                                                                     $Void)))))
+                                           (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
+                                           (&/T "lux;host" HostState))))
+                       $Void)))
+
 (def Macro
-  (let [SyntaxList (&/V "lux;AppT" (&/T List Syntax))]
-    (&/V "lux;LambdaT" (&/T SyntaxList
-                            (&/V "lux;LambdaT" (&/T CompilerState
-                                                    (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
-                                                                         (&/V "lux;TupleT" (&/|list CompilerState
-                                                                                                    SyntaxList))))))))
-    ))
+  (&/V "lux;LambdaT" (&/T SyntaxList
+                          (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE CompilerState))
+                                               SyntaxList)))))
 
 (defn bound? [id]
   (fn [state]
@@ -145,7 +167,7 @@
         
         [["lux;None" _]]
         (return* state false))
-      (fail* (str "[Type Error] Unknown type-var: " id)))))
+      (fail* (str "[Type Error] <bound?> Unknown type-var: " id)))))
 
 (defn deref [id]
   (fn [state]
@@ -159,7 +181,7 @@
                   
                   [["lux;None" _]]
                   (fail* (str "[Type Error] Unbound type-var: " id))))
-            (fail* (str "[Type Error] Unknown type-var: " id)))))))
+            (fail* (str "[Type Error] <deref> Unknown type-var: " id)))))))
 
 (defn set-var [id type]
   (fn [state]
@@ -175,7 +197,7 @@
                                                               ts))
                                   state)
                        nil))))
-      (fail* (str "[Type Error] Unknown type-var: " id)))))
+      (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|length))))))
 
 ;; [Exports]
 ;; Type vars
@@ -196,20 +218,23 @@
                                              (if (= id ?id)
                                                (return binding)
                                                (matchv ::M/objects [?type]
+                                                 [["lux;None" _]]
+                                                 (return binding)
+
                                                  [["lux;Some" ?type*]]
                                                  (matchv ::M/objects [?type*]
                                                    [["lux;VarT" ?id*]]
                                                    (if (= id ?id*)
                                                      (return (&/T ?id (&/V "lux;None" nil)))
-                                                     (|do [?type** (clean* id ?type*)]
-                                                       (return (&/T ?id (&/V "lux;Some" ?type**)))))
+                                                     (return binding)
+                                                     ;; (|do [?type** (clean* id ?type*)]
+                                                     ;;   (return (&/T ?id (&/V "lux;Some" ?type**))))
+                                                     )
 
                                                    [_]
                                                    (|do [?type** (clean* id ?type*)]
                                                      (return (&/T ?id (&/V "lux;Some" ?type**)))))
-                                                 
-                                                 [["lux;None" _]]
-                                                 (return binding)))))
+                                                 ))))
                                          (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
                    (fn [state]
                      (return* (&/update$ &/$TYPES #(->> %
@@ -237,6 +262,7 @@
     (if (= ?tid ?id)
       (&/try-all% (&/|list (deref ?id)
                            (return type)))
+      ;; (deref ?id)
       (return type))
     
     [["lux;LambdaT" [?arg ?return]]]
@@ -349,6 +375,9 @@
                           [_]
                           [args body*]))]
       (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
+
+    [_]
+    (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
     ))
 
 (defn type= [x y]
@@ -604,7 +633,7 @@
     [["lux;AppT" [F A]] _]
     (let [fp-pair (&/T expected actual)
           ;; _ (prn 'LEFT_APP (&/|length fixpoints))
-          _ (when (> (&/|length fixpoints) 20)
+          _ (when (> (&/|length fixpoints) 40)
               (println 'FIXPOINTS (->> (&/|keys fixpoints)
                                        (&/|map (fn [pair]
                                                  (|let [[e a] pair]
@@ -660,7 +689,8 @@
           (check* fixpoints expected actual*))))
 
     [["lux;DataT" e!name] ["lux;DataT" a!name]]
-    (if (= e!name a!name)
+    (if (or (= e!name a!name)
+            (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
       (return (&/T fixpoints nil))
       (fail (str "[Type Error] Names don't match: " e!name " & " a!name)))