- Now generating variants of the "apply" method of lux/Function up to 8 arities.

7 files changed, 70 insertions, 112 deletions

diff --git a/src/lux/base.clj b/src/lux/base.clj
index 02bd55112..d514e17e5 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -504,6 +504,11 @@
 (defn |length [xs]
   (fold (fn [acc _] (inc acc)) 0 xs))
 
+(defn |range* [from to]
+  (if (<= from to)
+    ($Cons from (|range* (inc from) to))
+    $Nil))
+
 (let [|range* (fn |range* [from to]
                 (if (< from to)
                   ($Cons from (|range* (inc from) to))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 89a608ad0..fe256a942 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -85,8 +85,8 @@
         (&o/$case ?value ?match)
         (&&case/compile-case compile-expression ?value ?match)
 
-        (&o/$function ?level ?scope ?env ?body)
-        (&&lambda/compile-function compile-expression ?level ?scope ?env ?body)
+        (&o/$function ?arity ?scope ?env ?body)
+        (&&lambda/compile-function compile-expression ?arity ?scope ?env ?body)
 
         ;; Must get rid of this one...
         (&o/$ann ?value-ex ?type-ex ?value-type)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 19d918ef9..1c5301a68 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -38,6 +38,7 @@
 (def ^String apply-method "apply")
 (defn ^String apply-signature [n]
   (str "(" (apply str (repeat n "Ljava/lang/Object;")) ")Ljava/lang/Object;"))
+(def num-apply-variants 8)
 
 (def exported-separator " ")
 (def def-separator "\t")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 54def6b76..0726e1ecf 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -536,45 +536,22 @@
                              (.visitInsn Opcodes/RETURN)
                              (.visitMaxs 0 0)
                              (.visitEnd))
-              =apply1 (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) &&/apply-method (&&/apply-signature 1) nil nil)
+              _ (dotimes [arity* &&/num-apply-variants]
+                  (let [arity (inc arity*)]
+                    (if (= 1 arity)
+                      (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) &&/apply-method (&&/apply-signature arity) nil nil)
                         (.visitEnd))
-              =apply2 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 2) nil nil)
+                      (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature arity) nil nil)
                         (.visitCode)
-                        (.visitVarInsn Opcodes/ALOAD 0)
-                        (.visitVarInsn Opcodes/ALOAD 1)
-                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
-                        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-                        (.visitVarInsn Opcodes/ALOAD 2)
-                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
-                        (.visitInsn Opcodes/ARETURN)
-                        (.visitMaxs 0 0)
-                        (.visitEnd))
-              =apply3 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 3) nil nil)
-                        (.visitCode)
-                        (.visitVarInsn Opcodes/ALOAD 0)
-                        (.visitVarInsn Opcodes/ALOAD 1)
-                        (.visitVarInsn Opcodes/ALOAD 2)
-                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 2))
+                        (-> (.visitVarInsn Opcodes/ALOAD idx)
+                            (->> (dotimes [idx arity])))
+                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature (dec arity)))
                         (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-                        (.visitVarInsn Opcodes/ALOAD 3)
+                        (.visitVarInsn Opcodes/ALOAD arity)
                         (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
                         (.visitInsn Opcodes/ARETURN)
                         (.visitMaxs 0 0)
-                        (.visitEnd))
-              =apply4 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 4) nil nil)
-                        (.visitCode)
-                        (.visitVarInsn Opcodes/ALOAD 0)
-                        (.visitVarInsn Opcodes/ALOAD 1)
-                        (.visitVarInsn Opcodes/ALOAD 2)
-                        (.visitVarInsn Opcodes/ALOAD 3)
-                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 3))
-                        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-                        (.visitVarInsn Opcodes/ALOAD 4)
-                        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
-                        (.visitInsn Opcodes/ARETURN)
-                        (.visitMaxs 0 0)
-                        (.visitEnd))
-              ]]
+                        (.visitEnd)))))]]
     (&&/save-class! (second (string/split &&/function-class #"/"))
                     (.toByteArray (doto =class .visitEnd)))))
 
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 3f3e1e5c7..7ef4e439d 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -64,44 +64,27 @@
         (->> (dotimes [idx amount])))))
 
 (defn ^:private ^MethodVisitor consecutive-applys [^MethodVisitor method-writer start amount]
-  (case amount
-    1 (doto method-writer
-        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-        (consecutive-args start 1)
-        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))
-    2 (doto method-writer
-        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-        (consecutive-args start 2)
-        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 2)))
-    3 (doto method-writer
-        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-        (consecutive-args start 3)
-        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 3)))
-    4 (doto method-writer
-        (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-        (consecutive-args start 4)
-        (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 4)))
-    ;; > 4
+  (let [max-args-num (min amount &&/num-apply-variants)]
     (doto method-writer
       (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
-      (consecutive-args start 4)
-      (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 4))
-      (consecutive-applys (+ start 4) (- amount 4)))
-    ))
+      (consecutive-args start max-args-num)
+      (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature max-args-num))
+      (-> (consecutive-applys (+ start &&/num-apply-variants) (- amount &&/num-apply-variants))
+          (->> (when (> amount &&/num-apply-variants)))))))
 
-(defn ^:private lambda-impl-signature [level]
-  (str "(" (&/fold str "" (&/|repeat level field-sig)) ")" lambda-return-sig))
+(defn ^:private lambda-impl-signature [arity]
+  (str "(" (&/fold str "" (&/|repeat arity field-sig)) ")" lambda-return-sig))
 
-(defn ^:private lambda-<init>-signature [env level]
-  (if (> level 1)
-    (str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) "I" (&/fold str "" (&/|repeat (dec level) field-sig)) ")"
+(defn ^:private lambda-<init>-signature [env arity]
+  (if (> arity 1)
+    (str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) "I" (&/fold str "" (&/|repeat (dec arity) field-sig)) ")"
          <init>-return)
     (str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) ")"
          <init>-return)))
 
-(defn ^:private add-lambda-<init> [class class-name level env]
+(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 level) nil nil)
+    (doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "<init>" (lambda-<init>-signature env arity) nil nil)
       (.visitCode)
       ;; Do normal object initialization
       (.visitVarInsn Opcodes/ALOAD 0)
@@ -114,16 +97,16 @@
             ;; 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 level)]))))
-          (->> (when (> level 1))))
+                     (dotimes [idx* (dec arity)]))))
+          (->> (when (> arity 1))))
       ;; Finish
       (.visitInsn Opcodes/RETURN)
       (.visitMaxs 0 0)
       (.visitEnd))))
 
 (let [impl-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL)]
-  (defn ^:private add-lambda-impl [class class-name compile level impl-body]
-    (&/with-writer (doto (.visitMethod ^ClassWriter class impl-flags "impl" (lambda-impl-signature level) nil nil)
+  (defn ^:private add-lambda-impl [class class-name compile arity impl-body]
+    (&/with-writer (doto (.visitMethod ^ClassWriter class impl-flags "impl" (lambda-impl-signature arity) nil nil)
                      (.visitCode))
       (|do [^MethodVisitor *writer* &/get-writer
             ret (compile impl-body)
@@ -133,7 +116,7 @@
                       (.visitEnd))]]
         (return ret)))))
 
-(defn ^:private instance-closure [compile lambda-class level closed-over]
+(defn ^:private instance-closure [compile lambda-class arity closed-over]
   (|do [^MethodVisitor *writer* &/get-writer
         :let [_ (doto *writer*
                   (.visitTypeInsn Opcodes/NEW lambda-class)
@@ -143,15 +126,15 @@
                       [?name [_ (&a/$captured _ _ ?source)]]
                       (compile ?source)))
                   closed-over)
-        :let [_ (when (> level 1)
+        :let [_ (when (> arity 1)
                   (doto *writer*
                     (.visitLdcInsn (int 0))
-                    (fill-nulls! (dec level))))]
-        :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" (lambda-<init>-signature closed-over level))]]
+                    (fill-nulls! (dec arity))))]
+        :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" (lambda-<init>-signature closed-over arity))]]
     (return nil)))
 
-(defn ^:private add-lambda-reset [class-writer class-name level env]
-  (if (> level 1)
+(defn ^:private add-lambda-reset [class-writer class-name arity env]
+  (if (> arity 1)
     (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "reset" (reset-signature class-name) nil nil)
       (.visitCode)
       (.visitTypeInsn Opcodes/NEW class-name)
@@ -159,8 +142,8 @@
       (-> (get-field! class-name (str &&/closure-prefix cidx))
           (->> (dotimes [cidx (&/|length env)])))
       (.visitLdcInsn (int 0))
-      (fill-nulls! (dec level))
-      (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env level))
+      (fill-nulls! (dec arity))
+      (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env arity))
       (.visitInsn Opcodes/ARETURN)
       (.visitMaxs 0 0)
       (.visitEnd))
@@ -171,9 +154,9 @@
       (.visitMaxs 0 0)
       (.visitEnd))))
 
-(defn ^:private add-lambda-apply-n [class-writer +degree+ class-name level env compile impl-body]
-  (if (> level 1)
-    (let [num-partials (dec level)
+(defn ^:private add-lambda-apply-n [class-writer +degree+ class-name arity env compile impl-body]
+  (if (> arity 1)
+    (let [num-partials (dec arity)
           $default (new Label)
           $labels* (map (fn [_] (new Label)) (repeat num-partials nil))
           $labels (vec (concat $labels* (list $default)))
@@ -188,7 +171,7 @@
                          (int (alength frame-locals)) frame-locals
                          (int (alength frame-stack))  frame-stack)
             (.visitTableSwitchInsn 0 (dec num-partials) $default (into-array Label $labels*))
-            ;; (< stage (- level +degree+))
+            ;; (< stage (- arity +degree+))
             (-> (doto (.visitLabel $label)
                   (.visitFrame Opcodes/F_NEW
                                (int (alength frame-locals)) frame-locals
@@ -203,9 +186,9 @@
                       (->> (dotimes [idx stage])))
                   (consecutive-args 1 +degree+)
                   (fill-nulls! (- (- num-partials +degree+) stage))
-                  (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env level))
+                  (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env arity))
                   (.visitJumpInsn Opcodes/GOTO $end))
-                (->> (cond (= stage (- level +degree+))
+                (->> (cond (= stage (- arity +degree+))
                            (doto method-writer
                              (.visitLabel $label)
                              (.visitFrame Opcodes/F_NEW
@@ -217,12 +200,12 @@
                              (-> (get-field! class-name (str &&/partial-prefix idx))
                                  (->> (dotimes [idx stage])))
                              (consecutive-args 1 +degree+)
-                             (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature level))
+                             (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature arity))
                              (.visitJumpInsn Opcodes/GOTO $end))
 
-                           (> stage (- level +degree+))
+                           (> stage (- arity +degree+))
                            (let [base 1
-                                 args-to-completion (- level stage)
+                                 args-to-completion (- arity stage)
                                  args-left (- +degree+ args-to-completion)]
                              (doto method-writer
                                (.visitLabel $label)
@@ -234,12 +217,12 @@
                                (-> (get-field! class-name (str &&/partial-prefix idx))
                                    (->> (dotimes [idx stage])))
                                (consecutive-args base args-to-completion)
-                               (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature level))
+                               (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature arity))
                                (consecutive-applys (+ base args-to-completion) args-left)
                                (.visitJumpInsn Opcodes/GOTO $end)))
 
                            :else)
-                     (doseq [[stage $label] (map vector (range level) $labels)])))
+                     (doseq [[stage $label] (map vector (range arity) $labels)])))
             (.visitLabel $end)
             (.visitInsn Opcodes/ARETURN)
             (.visitMaxs 0 0)
@@ -259,7 +242,7 @@
 ;; [Exports]
 (let [lambda-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
       datum-flags (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL)]
-  (defn compile-function [compile level ?scope ?env ?body]
+  (defn compile-function [compile arity ?scope ?env ?body]
     (|do [[file-name _ _] &/cursor
           :let [name (&host/location (&/|tail ?scope))
                 class-name (str (&host/->module-class (&/|head ?scope)) "/" name)
@@ -276,25 +259,17 @@
                                        (doto (.visitEnd)))
                                (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
                                    (doto (.visitEnd))
-                                   (->> (dotimes [idx (dec level)]))))
-                             (->> (when (> level 1))))
+                                   (->> (dotimes [idx (dec arity)]))))
+                             (->> (when (> arity 1))))
                          (.visitSource file-name nil)
-                         (add-lambda-<init> class-name level ?env)
-                         (add-lambda-reset class-name level ?env)
+                         (add-lambda-<init> class-name arity ?env)
+                         (add-lambda-reset class-name arity ?env)
                          )]
-          _ (if (> level 1)
-              (add-lambda-impl =class class-name compile level ?body)
-              (return nil))
-          _ (add-lambda-apply-n =class 1 class-name level ?env compile ?body)
-          _ (if (>= level 2)
-              (add-lambda-apply-n =class 2 class-name level ?env compile ?body)
-              (return nil))
-          _ (if (>= level 3)
-              (add-lambda-apply-n =class 3 class-name level ?env compile ?body)
-              (return nil))
-          _ (if (>= level 4)
-              (add-lambda-apply-n =class 4 class-name level ?env compile ?body)
+          _ (if (> arity 1)
+              (add-lambda-impl =class class-name compile arity ?body)
               (return nil))
+          _ (&/map% #(add-lambda-apply-n =class % class-name arity ?env compile ?body)
+                    (&/|range* 1 (min arity &&/num-apply-variants)))
           :let [_ (.visitEnd =class)]
           _ (&&/save-class! name (.toByteArray =class))]
-      (instance-closure compile class-name level ?env))))
+      (instance-closure compile class-name arity ?env))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index e1af775f7..0facb74c1 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -116,7 +116,7 @@
                           _ (&/map% compile ?args)
                           :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature (&/|length ?args)))]]
                       (return nil)))
-                  (&/|partition 4 ?args))]
+                  (&/|partition &&/num-apply-variants ?args))]
     (return nil)))
 
 (defn ^:private compile-def-type [compile ?body]
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 4b617b591..09f23886e 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -77,8 +77,8 @@
                        (&/T [_pattern (de-meta _body)])))
                    branches))
     
-    [meta ($function level scope captured body*)]
-    ($function level
+    [meta ($function arity scope captured body*)]
+    ($function arity
                scope
                (&/|map (fn [capture]
                          (|let [[_name _captured] capture]
@@ -126,8 +126,8 @@
                                         (shift-function-body own-body? _body)])))
                               branches))])
     
-    [meta ($function level scope captured body*)]
-    (&/T [meta ($function level
+    [meta ($function arity scope captured body*)]
+    (&/T [meta ($function arity
                           (de-scope scope)
                           (&/|map (fn [capture]
                                     (|let [[_name [_meta ($captured _scope _idx _source)]] capture]
@@ -215,8 +215,8 @@
     
     [meta (&-base/$lambda scope captured body)]
     (|case (optimize body)
-      [_ ($function _level _scope _captured _body)]
-      (&/T [meta ($function (inc _level) scope (optimize-closure optimize captured) (shift-function-body true _body))])
+      [_ ($function _arity _scope _captured _body)]
+      (&/T [meta ($function (inc _arity) scope (optimize-closure optimize captured) (shift-function-body true _body))])
 
       =body
       (&/T [meta ($function 1 scope (optimize-closure optimize captured) =body)]))