improve reflection

Author: borkdude

src/sci/impl/analyzer.cljc

@@ -1052,10 +1052,21 @@
                                                          args arg-count)
                            stack))))
                     (let [arg-count #?(:cljs nil :clj (count args))
-                          args (object-array args)]
+                          args (object-array args)
+                          #?@(:clj [^"[Ljava.lang.Class;" arg-types (when (and (pos? arg-count))
+                                                (make-array Class arg-count))
+                                    has-types? (volatile! nil)])]
+                      #?(:clj (when arg-types
+                                (areduce args idx _ret nil
+                                         (when-let [t (:tag-class (meta (aget args idx)))]
+                                           (vreset! has-types? true)
+                                           (aset arg-types idx t)))))
                       (with-meta (sci.impl.types/->Node
                                   (eval/eval-instance-method-invocation
-                                   ctx bindings instance-expr meth-name field-access args arg-count)
+                                   ctx bindings instance-expr meth-name field-access args arg-count
+                                   #?(:cljs nil
+                                      :clj (when @has-types?
+                                             arg-types)))
                                   stack)
                         {::instance-expr instance-expr
                          ::method-name method-name})))
@@ -1077,7 +1088,7 @@
                          (do
                            (sci.impl.types/->Node
                             (eval/eval-instance-method-invocation
-                             ctx bindings instance-expr meth-name field-access args allowed? nil)
+                             ctx bindings instance-expr meth-name field-access args allowed? nil nil)
                             stack)))
                        {::instance-expr instance-expr
                         ::method-name method-name}))))]
@@ -1609,7 +1620,7 @@
                                       (let [obj (sci.impl.types/eval obj ctx bindings)]
                                         (interop/invoke-instance-method ctx bindings obj clazz
                                                                         meth
-                                                                        children child-count))
+                                                                        children child-count nil))
                                       stack))])
                         #?@(:clj [(and f-meta (:sci.impl.analyzer/invoke-constructor f-meta))
                                   (invoke-constructor-node ctx (first f) (rest expr))])

src/sci/impl/evaluator.cljc

@@ -108,7 +108,7 @@
 #?(:cljs
    (defn allowed-instance-method-invocation [ctx bindings instance-expr method-str args arg-count]
      (let [instance-expr* (types/eval instance-expr ctx bindings)]
-       (interop/invoke-instance-method ctx bindings instance-expr* nil method-str args arg-count))))
+       (interop/invoke-instance-method ctx bindings instance-expr* nil method-str args arg-count nil))))
 
 #?(:cljs
    (defn allowed-instance-field-invocation [ctx bindings instance-expr method-str]
@@ -127,7 +127,7 @@
     none-sentinel))
 
 (defn eval-instance-method-invocation
-  [ctx bindings instance-expr method-str field-access args #?(:cljs allowed) arg-count]
+  [ctx bindings instance-expr method-str field-access args #?(:cljs allowed) arg-count arg-types]
   (let [instance-meta (meta instance-expr)
         tag-class (:tag-class instance-meta)
         instance-expr* (types/eval instance-expr ctx bindings)
@@ -154,7 +154,7 @@
           (throw-error-with-location (str "Method " method-str " on " instance-class " not allowed!") instance-expr))
         (if field-access
           (interop/invoke-instance-field instance-expr* target-class method-str)
-          (interop/invoke-instance-method ctx bindings instance-expr* target-class method-str args arg-count))))))
+          (interop/invoke-instance-method ctx bindings instance-expr* target-class method-str args arg-count arg-types))))))
 
 ;;;; End interop
 

src/sci/impl/interop.cljc

@@ -35,33 +35,26 @@
              meths)))))
 
 (defn invoke-instance-method
-  #?@(:cljs [[ctx bindings obj _target-class method-name args _arg-count]
+  #?@(:cljs [[ctx bindings obj _target-class method-name args _arg-count _arg-types]
              ;; gobject/get didn't work here
              (if-some [method (aget obj method-name)]
                ;; use Reflect rather than (.apply method ...), see https://github.com/babashka/nbb/issues/118
                (let [args (.map args #(sci.impl.types/eval % ctx bindings))]
                  (js/Reflect.apply method obj args))
                (throw (js/Error. (str "Could not find instance method: " method-name))))]
       :clj
-      [[ctx bindings obj ^Class target-class method ^objects args arg-count]
+      [[ctx bindings obj ^Class target-class method ^objects args arg-count arg-types]
        (let [^java.util.List methods
              (meth-cache ctx target-class method arg-count #(Reflector/getMethods target-class arg-count method false) :instance-methods)
              zero-args? (zero? arg-count)]
          (if (and zero-args? (.isEmpty ^java.util.List methods))
            (invoke-instance-field obj target-class method)
-           (do (let [args-array (object-array arg-count)
-                     ;; TODO: this can all be done at analysis time
-                     ^"[Ljava.lang.Class;" types-array (when (and (not zero-args?)
-                                                                  (> (.size methods) 1))
-                                                         (make-array Class arg-count))]
+           (do (let [args-array (object-array arg-count)]
                  (areduce args idx _ret nil
-                          (do (aset args-array idx (sci.impl.types/eval (aget args idx) ctx bindings))
-                              (when types-array
-                                (when-let [t (:tag-class (meta (aget args idx)))]
-                                  (aset types-array idx t)))))
+                          (aset args-array idx (sci.impl.types/eval (aget args idx) ctx bindings)))
                  ;; Note: I also tried caching the method that invokeMatchingMethod looks up, but retrieving it from the cache was actually more expensive than just doing the invocation!
                  ;; See getMatchingMethod in Reflector
-                 (Reflector/invokeMatchingMethod method methods target-class obj args-array types-array)))))]))
+                 (Reflector/invokeMatchingMethod method methods target-class obj args-array arg-types)))))]))
 
 (defn get-static-field [^Class class field-name-sym]
   #?(:clj (Reflector/getStaticField class (str field-name-sym))