1 files changed, 154 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux
new file mode 100644
index 000000000..592c798ec
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux
@@ -0,0 +1,154 @@
+(.module:
+  [lux (#- Type type)
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try]]
+   [data
+    [number
+     ["n" nat]
+     ["i" int]
+     ["." i32]]
+    [collection
+     ["." list ("#@." monoid functor)]]]
+   [target
+    [jvm
+     ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
+     ["." method (#+ Method)]
+     [constant
+      [pool (#+ Resource)]]
+     [encoding
+      ["." signed]]
+     ["." type (#+ Type)
+      ["." category (#+ Class)]]]]]
+  ["." //
+   ["#." reset]
+   ["#." implementation]
+   ["#." init]
+   ["/#" // #_
+    ["#." abstract]
+    [field
+     [constant
+      ["#." arity]]
+     [variable
+      ["#." partial
+       ["#/." count]]
+      ["#." foreign]]]
+    ["/#" // #_
+     ["#." runtime]
+     ["#." value]
+     ["#." reference]
+     [////
+      [analysis (#+ Environment)]
+      [///
+       [arity (#+ Arity)]
+       ["." reference (#+ Register)]]]]]])
+
+(def: (increment by)
+  (-> Nat (Bytecode Any))
+  ($_ _.compose
+      (<| _.int .i64 by)
+      _.iadd))
+
+(def: (inputs offset amount)
+  (-> Register Nat (Bytecode Any))
+  ($_ _.compose
+      (|> amount
+          list.indices
+          (monad.map _.monad (|>> (n.+ offset) _.aload)))
+      (_@wrap [])
+      ))
+
+(def: (apply offset amount)
+  (-> Register Nat (Bytecode Any))
+  (let [arity (n.min amount ///arity.maximum)]
+    ($_ _.compose
+        (_.checkcast ///abstract.class)
+        (..inputs offset arity)
+        (_.invokevirtual ///abstract.class ////runtime.apply::name (////runtime.apply::type arity))
+        (if (n.> ///arity.maximum amount)
+          (apply (n.+ ///arity.maximum offset)
+                 (n.- ///arity.maximum amount))
+          (_@wrap []))
+        )))
+
+(def: this-offset 1)
+
+(def: #export (method class environment function-arity @begin body apply-arity)
+  (-> (Type Class) Environment Arity Label (Bytecode Any) Arity (Resource Method))
+  (let [num-partials (dec function-arity)
+        over-extent (i.- (.int apply-arity)
+                         (.int function-arity))]
+    (method.method //.modifier ////runtime.apply::name
+                   (////runtime.apply::type apply-arity)
+                   (list)
+                   (#.Some (case num-partials
+                             0 ($_ _.compose
+                                   ////reference.this
+                                   (..inputs ..this-offset apply-arity)
+                                   (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+                                   _.areturn)
+                             _ (do _.monad
+                                 [@default _.new-label
+                                  @labelsH _.new-label
+                                  @labelsT (|> _.new-label
+                                               (list.repeat (dec num-partials))
+                                               (monad.seq _.monad))
+                                  #let [cases (|> (list@compose (#.Cons [@labelsH @labelsT])
+                                                                (list @default))
+                                                  list.enumerate
+                                                  (list@map (function (_ [stage @case])
+                                                              (let [current-partials (|> (list.indices stage)
+                                                                                         (list@map (///partial.get class))
+                                                                                         (monad.seq _.monad))
+                                                                    already-partial? (n.> 0 stage)
+                                                                    exact-match? (i.= over-extent (.int stage))
+                                                                    has-more-than-necessary? (i.> over-extent (.int stage))]
+                                                                ($_ _.compose
+                                                                    (_.set-label @case)
+                                                                    (cond exact-match?
+                                                                          ($_ _.compose
+                                                                              ////reference.this
+                                                                              (if already-partial?
+                                                                                (_.invokevirtual class //reset.name (//reset.type class))
+                                                                                (_@wrap []))
+                                                                              current-partials
+                                                                              (..inputs ..this-offset apply-arity)
+                                                                              (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+                                                                              _.areturn)
+                                                                          
+                                                                          has-more-than-necessary?
+                                                                          (let [inputs-to-completion (|> function-arity (n.- stage))
+                                                                                inputs-left (|> apply-arity (n.- inputs-to-completion))]
+                                                                            ($_ _.compose
+                                                                                ////reference.this
+                                                                                (_.invokevirtual class //reset.name (//reset.type class))
+                                                                                current-partials
+                                                                                (..inputs ..this-offset inputs-to-completion)
+                                                                                (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+                                                                                (apply (n.+ ..this-offset inputs-to-completion) inputs-left)
+                                                                                _.areturn))
+
+                                                                          ## (i.< over-extent (.int stage))
+                                                                          (let [current-environment (|> (list.indices (list.size environment))
+                                                                                                        (list@map (///foreign.get class))
+                                                                                                        (monad.seq _.monad))
+                                                                                missing-partials (|> _.aconst-null
+                                                                                                     (list.repeat (|> num-partials (n.- apply-arity) (n.- stage)))
+                                                                                                     (monad.seq _.monad))]
+                                                                            ($_ _.compose
+                                                                                (_.new class)
+                                                                                _.dup
+                                                                                current-environment
+                                                                                ///partial/count.value
+                                                                                (..increment apply-arity)
+                                                                                current-partials
+                                                                                (..inputs ..this-offset apply-arity)
+                                                                                missing-partials
+                                                                                (_.invokevirtual class //init.name (//init.type environment function-arity))
+                                                                                _.areturn)))))))
+                                                  (monad.seq _.monad))]]
+                                 ($_ _.compose
+                                     ///partial/count.value
+                                     (_.tableswitch (try.assume (signed.s4 +0)) @default [@labelsH @labelsT])
+                                     cases)))))))