- Fixed a bug that allowed pattern-matching using unknown tags to proceed.

- Streamlined invocation of functions when the args-list >= the arity. The impl method gets called immediately, instead of passing first by the apply method.

5 files changed, 72 insertions, 27 deletions

diff --git a/src/lux/base.clj b/src/lux/base.clj
index 622b5b1fc..89f9bb36a 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -266,9 +266,11 @@
 
                             ;; else
                             (mapv transform-pattern pattern))
-        (seq? pattern) [(-> (ns-resolve *ns* (first pattern))
-                            meta
-                            ::idx)
+        (seq? pattern) [(if-let [tag-var (ns-resolve *ns* (first pattern))]
+                          (-> tag-var
+                              meta
+                              ::idx)
+                          (assert false (str "Unknown var: " (first pattern))))
                         '_
                         (transform-pattern (vec (rest pattern)))]
         :else pattern
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 1c5301a68..1cc310564 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -39,6 +39,8 @@
 (defn ^String apply-signature [n]
   (str "(" (apply str (repeat n "Ljava/lang/Object;")) ")Ljava/lang/Object;"))
 (def num-apply-variants 8)
+(def arity-field "_arity_")
+(def partials-field "_partials_")
 
 (def exported-separator " ")
 (def def-separator "\t")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 0726e1ecf..da0d6f788 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -528,11 +528,16 @@
                                                          Opcodes/ACC_ABSTRACT
                                                          ;; Opcodes/ACC_INTERFACE
                                                          )
-                               &&/function-class nil super-class (into-array String [])))
-              =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "()V" nil nil)
+                               &&/function-class nil super-class (into-array String []))
+                       (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL) &&/partials-field "I" nil nil)
+                           (doto (.visitEnd))))
+              =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "(I)V" nil nil)
                              (.visitCode)
                              (.visitVarInsn Opcodes/ALOAD 0)
                              (.visitMethodInsn Opcodes/INVOKESPECIAL super-class init-method "()V")
+                             (.visitVarInsn Opcodes/ALOAD 0)
+                             (.visitVarInsn Opcodes/ILOAD 1)
+                             (.visitFieldInsn Opcodes/PUTFIELD &&/function-class &&/partials-field "I")
                              (.visitInsn Opcodes/RETURN)
                              (.visitMaxs 0 0)
                              (.visitEnd))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 7ef4e439d..2bc0c29eb 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -28,14 +28,14 @@
 (def ^:private field-sig (&host-generics/->type-signature "java.lang.Object"))
 (def ^:private lambda-return-sig (&host-generics/->type-signature "java.lang.Object"))
 (def ^:private <init>-return "V")
-(def ^:private num-args-field "_num_args_")
+
 (defn ^:private ^String reset-signature [function-class]
   (str "()" (&host-generics/->type-signature function-class)))
 
-(defn ^:private ^MethodVisitor get-num-args! [^MethodVisitor method-writer class-name]
+(defn ^:private ^MethodVisitor get-num-partials! [^MethodVisitor method-writer]
   (doto method-writer
     (.visitVarInsn Opcodes/ALOAD 0)
-    (.visitFieldInsn Opcodes/GETFIELD class-name num-args-field "I")))
+    (.visitFieldInsn Opcodes/GETFIELD &&/function-class &&/partials-field "I")))
 
 (defn ^:private ^MethodVisitor inc-int! [^MethodVisitor method-writer by]
   (doto method-writer
@@ -82,23 +82,30 @@
     (str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) ")"
          <init>-return)))
 
+(defn ^:private init-function [method-writer arity closure-length]
+  (if (= 1 arity)
+    (doto method-writer
+      (.visitLdcInsn (int 0))
+      (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "(I)V"))
+    (doto method-writer
+      (.visitVarInsn Opcodes/ILOAD (inc closure-length))
+      (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "(I)V"))))
+
 (defn ^:private add-lambda-<init> [class class-name arity env]
   (let [closure-length (&/|length env)]
     (doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "<init>" (lambda-<init>-signature env arity) nil nil)
       (.visitCode)
       ;; Do normal object initialization
       (.visitVarInsn Opcodes/ALOAD 0)
-      (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "()V")
+      (init-function arity closure-length)
       ;; Add all of the closure variables
       (-> (put-field! class-name (str &&/closure-prefix ?captured-id) field-sig #(.visitVarInsn % Opcodes/ALOAD (inc ?captured-id)))
           (->> (|let [[?name [_ (&o/$captured _ ?captured-id ?source)]] ?name+?captured])
                (doseq [?name+?captured (&/->seq env)])))
-      (-> (doto (put-field! class-name num-args-field "I" #(.visitVarInsn % Opcodes/ILOAD (inc closure-length))) ;; Add the counter
-            ;; Add all the partial arguments
-            (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn % Opcodes/ALOAD partial-register))
-                (->> (|let [partial-register (+ (inc idx*) (inc closure-length))])
-                     (dotimes [idx* (dec arity)]))))
-          (->> (when (> arity 1))))
+      ;; Add all the partial arguments
+      (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn % Opcodes/ALOAD partial-register))
+          (->> (|let [partial-register (+ (inc idx*) (inc closure-length))])
+               (dotimes [idx* (dec arity)])))
       ;; Finish
       (.visitInsn Opcodes/RETURN)
       (.visitMaxs 0 0)
@@ -166,7 +173,7 @@
           frame-stack (to-array [Opcodes/INTEGER])]
       (do (doto method-writer
             (.visitCode)
-            (get-num-args! class-name)
+            get-num-partials!
             (.visitFrame Opcodes/F_NEW
                          (int (alength frame-locals)) frame-locals
                          (int (alength frame-stack))  frame-stack)
@@ -180,7 +187,7 @@
                   (.visitInsn Opcodes/DUP)
                   (-> (get-field! class-name (str &&/closure-prefix cidx))
                       (->> (dotimes [cidx (&/|length env)])))
-                  (get-num-args! class-name)
+                  get-num-partials!
                   (inc-int! +degree+)
                   (-> (get-field! class-name (str &&/partial-prefix idx))
                       (->> (dotimes [idx stage])))
@@ -249,18 +256,17 @@
                 =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                          (.visit &host/bytecode-version lambda-flags
                                  class-name nil &&/function-class (into-array String []))
+                         (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) &&/arity-field "I" nil (int arity))
+                             (doto (.visitEnd)))
                          (-> (doto (.visitField datum-flags captured-name field-sig nil nil)
                                (.visitEnd))
                              (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
                                   (|case ?name+?captured
                                     [?name [_ (&o/$captured _ ?captured-id ?source)]])
                                   (doseq [?name+?captured (&/->seq ?env)])))
-                         (-> (doto (-> (.visitField datum-flags num-args-field "I" nil nil)
-                                       (doto (.visitEnd)))
-                               (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
-                                   (doto (.visitEnd))
-                                   (->> (dotimes [idx (dec arity)]))))
-                             (->> (when (> arity 1))))
+                         (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
+                             (doto (.visitEnd))
+                             (->> (dotimes [idx (dec arity)])))
                          (.visitSource file-name nil)
                          (add-lambda-<init> class-name arity ?env)
                          (add-lambda-reset class-name arity ?env)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 0facb74c1..f2c67bfae 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -14,7 +14,8 @@
                  [lexer :as &lexer]
                  [parser :as &parser]
                  [analyser :as &analyser]
-                 [host :as &host])
+                 [host :as &host]
+                 [optimizer :as &o])
             [lux.host.generics :as &host-generics]
             (lux.analyser [base :as &a]
                           [module :as &a-module]
@@ -25,7 +26,8 @@
   (:import (org.objectweb.asm Opcodes
                               Label
                               ClassWriter
-                              MethodVisitor)))
+                              MethodVisitor)
+           java.lang.reflect.Field))
 
 ;; [Exports]
 (defn compile-bool [compile ?value]
@@ -108,9 +110,8 @@
         :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&host/def-name ?name)) &/value-field "Ljava/lang/Object;")]]
     (return nil)))
 
-(defn compile-apply [compile ?fn ?args]
+(defn ^:private compile-apply* [compile ?args]
   (|do [^MethodVisitor *writer* &/get-writer
-        _ (compile ?fn)
         _ (&/map% (fn [?args]
                     (|do [:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST &&/function-class)]
                           _ (&/map% compile ?args)
@@ -119,6 +120,35 @@
                   (&/|partition &&/num-apply-variants ?args))]
     (return nil)))
 
+(defn compile-apply [compile ?fn ?args]
+  (|case ?fn
+    [_ (&o/$var (&/$Global ?module ?name))]
+    (|do [[_ [_ _ func-obj]] (&a-module/find-def ?module ?name)
+          class-loader &/loader
+          :let [func-class (class func-obj)
+                func-arity (.get ^Field (.getDeclaredField func-class &&/arity-field) nil)
+                func-partials (.get ^Field (.getDeclaredField (Class/forName "lux.Function" true class-loader) &&/partials-field) func-obj)
+                num-args (&/|length ?args)
+                func-class-name (->> func-class .getName &host-generics/->bytecode-class-name)]]
+      (if (and (= 0 func-partials)
+               (>= num-args func-arity))
+        (|do [_ (compile ?fn)
+              ^MethodVisitor *writer* &/get-writer
+              :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST func-class-name)]
+              _ (&/map% compile (&/|take func-arity ?args))
+              :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL func-class-name (if (= 1 func-arity) &&/apply-method "impl") (&&/apply-signature func-arity))]
+              _ (if (= num-args func-arity)
+                  (return nil)
+                  (compile-apply* compile (&/|drop func-arity ?args)))]
+          (return nil))
+        (|do [_ (compile ?fn)]
+          (compile-apply* compile ?args))))
+    
+    _
+    (|do [_ (compile ?fn)]
+      (compile-apply* compile ?args))
+    ))
+
 (defn ^:private compile-def-type [compile ?body]
   (|do [:let [?def-type (|case ?body
                           [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)]