- The backwards analysis of function application is back.

3 files changed, 108 insertions, 105 deletions

diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 90811c77e..6bbcd0fcf 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -115,112 +115,110 @@
               ;;      [?module ?name]
               ;;      [(if (.equals "" ?module) module-name ?module)
               ;;       ?name])
-            ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
-                                                               ?name)
-                   ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
-                   endo-type (matchv ::M/objects [$def]
-                               [["lux;ValueD" ?type]]
-                               (return ?type)
-
-                               [["lux;MacroD" _]]
-                               (return &type/Macro)
-
-                               [["lux;TypeD" _]]
-                               (return &type/Type))
-                   _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
-                              (clojure.lang.Util/identical &type/Type exo-type))
-                       (return nil)
-                       (&type/check exo-type endo-type))]
-               (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
-                                     endo-type))))
-             state))
+              ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
+                                                                 ?name)
+                     ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
+                     endo-type (matchv ::M/objects [$def]
+                                 [["lux;ValueD" ?type]]
+                                 (return ?type)
+
+                                 [["lux;MacroD" _]]
+                                 (return &type/Macro)
+
+                                 [["lux;TypeD" _]]
+                                 (return &type/Type))
+                     _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+                                (clojure.lang.Util/identical &type/Type exo-type))
+                         (return nil)
+                         (&type/check exo-type endo-type))]
+                 (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+                                       endo-type))))
+               state))
 
           [["lux;Cons" [?genv ["lux;Nil" _]]]]
           (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
-            (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
-              (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0))
-                (matchv ::M/objects [global]
-                  [[["lux;Global" [?module* ?name*]] _]]
-                  ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
-                         ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
-                         endo-type (matchv ::M/objects [$def]
-                                     [["lux;ValueD" ?type]]
-                                     (return ?type)
-
-                                     [["lux;MacroD" _]]
-                                     (return &type/Macro)
-
-                                     [["lux;TypeD" _]]
-                                     (return &type/Type))
-                         _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
-                                    (clojure.lang.Util/identical &type/Type exo-type))
-                             (return nil)
-                             (&type/check exo-type endo-type))]
-                     (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
-                                           endo-type))))
-                   state)
-
-                  [_]
-                  (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident)
-                    (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
-              (fail* "_{_ analyse-symbol _}_")))
+              (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
+                (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0))
+                    (matchv ::M/objects [global]
+                      [[["lux;Global" [?module* ?name*]] _]]
+                      ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
+                             ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
+                             endo-type (matchv ::M/objects [$def]
+                                         [["lux;ValueD" ?type]]
+                                         (return ?type)
+
+                                         [["lux;MacroD" _]]
+                                         (return &type/Macro)
+
+                                         [["lux;TypeD" _]]
+                                         (return &type/Type))
+                             _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+                                        (clojure.lang.Util/identical &type/Type exo-type))
+                                 (return nil)
+                                 (&type/check exo-type endo-type))]
+                         (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+                                               endo-type))))
+                       state)
+
+                      [_]
+                      (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident)
+                          (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
+                (fail* "_{_ analyse-symbol _}_")))
           
           [["lux;Cons" [top-outer _]]]
           (do ;; (prn 'analyse-symbol/_3 ?module ?name)
-            (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
-                                            (&/|map #(&/get$ &/$NAME %) outer)
-                                            (&/|reverse inner)))
-                   [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
-                                              (|let [[register new-inner] register+new-inner
-                                                     [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)]
-                                                (&/T register* (&/|cons frame* new-inner))))
-                                            (&/T (or (->> top-outer (&/get$ &/$LOCALS)  (&/get$ &/$MAPPINGS) (&/|get local-ident))
-                                                     (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
-                                                 (&/|list))
-                                            (&/|reverse inner) scopes)]
-              ((|do [btype (&&/expr-type =local)
-                     _ (&type/check exo-type btype)]
-                 (return (&/|list =local)))
-               (&/set$ &/$ENVS (&/|++ inner* outer) state))))
+              (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
+                                              (&/|map #(&/get$ &/$NAME %) outer)
+                                              (&/|reverse inner)))
+                     [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
+                                                (|let [[register new-inner] register+new-inner
+                                                       [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)]
+                                                  (&/T register* (&/|cons frame* new-inner))))
+                                              (&/T (or (->> top-outer (&/get$ &/$LOCALS)  (&/get$ &/$MAPPINGS) (&/|get local-ident))
+                                                       (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
+                                                   (&/|list))
+                                              (&/|reverse inner) scopes)]
+                ((|do [btype (&&/expr-type =local)
+                       _ (&type/check exo-type btype)]
+                   (return (&/|list =local)))
+                 (&/set$ &/$ENVS (&/|++ inner* outer) state))))
           )))
     ))
 
-(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
-  (matchv ::M/objects [=fn]
-    [[?fun-expr ?fun-type]]
-    (matchv ::M/objects [?args]
-      [["lux;Nil" _]]
-      (|do [_ (&type/check exo-type ?fun-type)]
-        (return =fn))
-      
-      [["lux;Cons" [?arg ?args*]]]
-      (|do [?fun-type* (&type/actual-type ?fun-type)]
-        (matchv ::M/objects [?fun-type*]
-          [["lux;AllT" _]]
-          (&type/with-var
-            (fn [$var]
-              (|do [type* (&type/apply-type ?fun-type* $var)
-                    output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)]
-                (matchv ::M/objects [output $var]
-                  [[?expr* ?type*] ["lux;VarT" ?id]]
-                  (|do [? (&type/bound? ?id)
-                        _ (if ?
-                            (return nil)
-                            (|do [ex &type/existential]
-                              (&type/set-var ?id ex)))
-                        type** (&type/clean $var ?type*)]
-                    (return (&/T ?expr* type**)))
-                  ))))
-
-          [["lux;LambdaT" [?input-t ?output-t]]]
-          (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
-            (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg))
-                                                  ?output-t)
-                            ?args*))
+(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
+  ;; (prn 'analyse-apply* (aget fun-type 0))
+  (matchv ::M/objects [?args]
+    [["lux;Nil" _]]
+    (|do [_ (&type/check exo-type fun-type)]
+      (return (&/T fun-type (&/|list))))
+    
+    [["lux;Cons" [?arg ?args*]]]
+    (|do [?fun-type* (&type/actual-type fun-type)]
+      (matchv ::M/objects [?fun-type*]
+        [["lux;AllT" _]]
+        (&type/with-var
+          (fn [$var]
+            (|do [type* (&type/apply-type ?fun-type* $var)
+                  [=output-t =args] (analyse-apply* analyse exo-type type* ?args)]
+              (matchv ::M/objects [$var]
+                [["lux;VarT" ?id]]
+                (|do [? (&type/bound? ?id)
+                      _ (if ?
+                          (return nil)
+                          (|do [ex &type/existential]
+                            (&type/set-var ?id ex)))
+                      type** (&type/clean $var =output-t)]
+                  (return (&/T type** =args)))
+                ))))
+
+        [["lux;LambdaT" [?input-t ?output-t]]]
+        (|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*)
+              =arg (&&/analyse-1 analyse ?input-t ?arg)]
+          (return (&/T =output-t (&/|cons =arg =args))))
 
-          [_]
-          (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
-      )))
+        [_]
+        (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
+    ))
 
 (defn analyse-apply [analyse exo-type =fn ?args]
   (|do [loader &/loader]
@@ -235,12 +233,14 @@
               (&/flat-map% (partial analyse exo-type) macro-expansion))
 
             [_]
-            (|do [output (analyse-apply* analyse exo-type =fn ?args)]
-              (return (&/|list output)))))
+            (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
+              (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+                                    =output-t))))))
         
         [_]
-        (|do [output (analyse-apply* analyse exo-type =fn ?args)]
-          (return (&/|list output))))
+        (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
+          (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+                                =output-t)))))
       )))
 
 (defn analyse-case [analyse exo-type ?value ?branches]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index d88c33437..1970c548a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -60,8 +60,8 @@
       [["lux;Global" [?owner-class ?name]]]
       (&&lux/compile-global compile-expression ?type ?owner-class ?name)
 
-      [["apply" [?fn ?arg]]]
-      (&&lux/compile-apply compile-expression ?type ?fn ?arg)
+      [["apply" [?fn ?args]]]
+      (&&lux/compile-apply compile-expression ?type ?fn ?args)
 
       [["variant" [?tag ?members]]]
       (&&lux/compile-variant compile-expression ?type ?tag ?members)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index c8197da66..ecb614732 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -117,11 +117,14 @@
         :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]]
     (return nil)))
 
-(defn compile-apply [compile *type* ?fn ?arg]
+(defn compile-apply [compile *type* ?fn ?args]
   (|do [^MethodVisitor *writer* &/get-writer
         _ (compile ?fn)
-        _ (compile ?arg)
-        :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
+        _ (&/map% (fn [?arg]
+                    (|do [=arg (compile ?arg)
+                          :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
+                      (return =arg)))
+                  ?args)]
     (return nil)))
 
 (defn ^:private type->analysis [type]