- Now analysing function-application backwards.

4 files changed, 84 insertions, 81 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 8fad07dfa..939a3ea0a 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -26,44 +26,45 @@
                                                              ["lux;Nil" _]]]]]]]]]
     (&/T catch+ ?finally-body)))
 
-(defn ^:private aba1 [analyse eval! exo-type token]
-  (matchv ::M/objects [token]
-    ;; Standard special forms
-    [["lux;Meta" [meta ["lux;Bool" ?value]]]]
-    (|do [_ (&type/check exo-type &type/Bool)]
-      (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
-
-    [["lux;Meta" [meta ["lux;Int" ?value]]]]
-    (|do [_ (&type/check exo-type &type/Int)]
-      (return (&/|list (&/T (&/V "int" ?value) exo-type))))
-
-    [["lux;Meta" [meta ["lux;Real" ?value]]]]
-    (|do [_ (&type/check exo-type &type/Real)]
-      (return (&/|list (&/T (&/V "real" ?value) exo-type))))
-
-    [["lux;Meta" [meta ["lux;Char" ?value]]]]
-    (|do [_ (&type/check exo-type &type/Char)]
-      (return (&/|list (&/T (&/V "char" ?value) exo-type))))
-
-    [["lux;Meta" [meta ["lux;Text" ?value]]]]
-    (|do [_ (&type/check exo-type &type/Text)]
-      (return (&/|list (&/T (&/V "text" ?value) exo-type))))
-
-    [["lux;Meta" [meta ["lux;Tuple" ?elems]]]]
-    (&&lux/analyse-tuple analyse exo-type ?elems)
+(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))]
+  (defn ^:private aba1 [analyse eval! exo-type token]
+    (matchv ::M/objects [token]
+      ;; Standard special forms
+      [["lux;Meta" [meta ["lux;Bool" ?value]]]]
+      (|do [_ (&type/check exo-type &type/Bool)]
+        (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
+
+      [["lux;Meta" [meta ["lux;Int" ?value]]]]
+      (|do [_ (&type/check exo-type &type/Int)]
+        (return (&/|list (&/T (&/V "int" ?value) exo-type))))
+
+      [["lux;Meta" [meta ["lux;Real" ?value]]]]
+      (|do [_ (&type/check exo-type &type/Real)]
+        (return (&/|list (&/T (&/V "real" ?value) exo-type))))
+
+      [["lux;Meta" [meta ["lux;Char" ?value]]]]
+      (|do [_ (&type/check exo-type &type/Char)]
+        (return (&/|list (&/T (&/V "char" ?value) exo-type))))
+
+      [["lux;Meta" [meta ["lux;Text" ?value]]]]
+      (|do [_ (&type/check exo-type &type/Text)]
+        (return (&/|list (&/T (&/V "text" ?value) exo-type))))
+
+      [["lux;Meta" [meta ["lux;Tuple" ?elems]]]]
+      (&&lux/analyse-tuple analyse exo-type ?elems)
+
+      [["lux;Meta" [meta ["lux;Record" ?elems]]]]
+      (&&lux/analyse-record analyse exo-type ?elems)
+
+      [["lux;Meta" [meta ["lux;Tag" ?ident]]]]
+      (&&lux/analyse-variant analyse exo-type ?ident unit)
+      
+      [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
+      (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
 
-    [["lux;Meta" [meta ["lux;Record" ?elems]]]]
-    (&&lux/analyse-record analyse exo-type ?elems)
-
-    [["lux;Meta" [meta ["lux;Tag" ?ident]]]]
-    (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list)))))
-    
-    [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
-    (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
-
-    [_]
-    (fail "")
-    ))
+      [_]
+      (fail "")
+      )))
 
 (defn ^:private aba2 [analyse eval! exo-type token]
   (matchv ::M/objects [token]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index df87a08b6..e4237d8dd 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -172,42 +172,39 @@
           )))
     ))
 
-(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]
+  (matchv ::M/objects [args]
+    [["lux;Nil" _]]
+    (|do [_ (&type/check exo-type fun-type)]
+      (return (&/T (&/|list) fun-type)))
+    
+    [["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)
+                  [?args** ?type**] (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 ?type**)]
+                  (return (&/T ?args** type***)))
+                ))))
+
+        [["lux;LambdaT" [?input-t ?output-t]]]
+        (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*)
+              =arg (&&/analyse-1 analyse ?input-t ?arg)]
+          (return (&/T (&/|cons =arg =args) ?output-t*)))
 
-          [_]
-          (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]
@@ -222,12 +219,14 @@
               (&/flat-map% (partial analyse exo-type) macro-expansion))
 
             [_]
-            (|do [output (analyse-apply* analyse exo-type =fn ?args)]
-              (return (&/|list output)))))
+            (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
+              (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+                                    =app-type))))))
         
         [_]
-        (|do [output (analyse-apply* analyse exo-type =fn ?args)]
-          (return (&/|list output))))
+        (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
+          (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+                                =app-type)))))
       )))
 
 (defn analyse-case [analyse exo-type ?value ?branches]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 40bb3a710..6739c5529 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 cf4a65f04..2c5073a4d 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -117,11 +117,14 @@
         :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?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 [_ (compile ?arg)
+                          :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
+                      (return nil)))
+                  ?args)]
     (return nil)))
 
 (defn compile-def [compile ?name ?body ?def-data]