The JSS reader macro generates a lambda, so the typical pattern one sees is:
(#"matches" 'integer ".*a" )
->
((LAMBDA (#:|#"matches"-first| &REST #:|#"matches"-rest|)
(JSS:INVOKE-RESTARGS "matches"
#:|#"matches"-first|
#:|#"matches"-rest|
NIL))
'INTEGER ".*a")
(yes I know this will generate an error at runtime)
Right now the compiled code for one such call goes through 3 functions:
(JSTATIC "matches" #<java class java.lang.Integer {3BBD30F}> ".*a")
(APPLY #<JSTATIC {41D16045}> "matches" #<java class java.lang.Integer {3BBD30F}> (".*a"))
(INVOKE-RESTARGS "matches" INTEGER (".*a") NIL)
Really we only need: (JSTATIC "matches" #<java class java.lang.Integer {3BBD30F}> ".*a")
and we know enough at compile time to generate that form.
If only I could figure out where the right hook would be.
The only place I could figure to do this is in precompile-function-call [1]
With a hook in place, i define the hook as [2]
After checking if the function call is one of the JSS ones, the hook transforms
((lambda(a b ) (jss::invoke-restargs-experimental method a b raw?) c d)
to
(jss::invoke-restargs-experimental method c '(d) raw? t)
jss::invoke-restargs-experimental is macro that does the transformation I want. [3]
The question is: Is there a more elegant way to do this, or a hook already built that I could use instead of redefining precompile-function-call
If not, would it be reasonable to add a hook in the ABCL source so I don't need to patch it to do the optimization.
Alan
[1]
(defun precompile-function-call (form)
(let ((op (car form)))
(when (and (consp op) (eq (%car op) 'LAMBDA))
(return-from precompile-function-call
I added this line
---
(or (jss-fix-precompile op (mapcar #'precompile1 (cdr form)))
---
(cons (precompile-lambda op)
(mapcar #'precompile1 (cdr form))))))
(when (or (not *in-jvm-compile*) (notinline-p op))
(return-from precompile-function-call (precompile-cons form)))
(when (source-transform op)
(let ((new-form (expand-source-transform form)))
(when (neq new-form form)
(return-from precompile-function-call (precompile1 new-form)))))
(when *enable-inline-expansion*
(let ((expansion (inline-expansion op)))
(when expansion
(let ((explain *explain*))
(when (and explain (memq :calls explain))
(format t "; inlining call to ~S~%" op)))
(return-from precompile-function-call (precompile1 (expand-inline form expansion))))))
(cons op (mapcar #'precompile1 (cdr form)))))
[2]
(defun jss-fix-precompile (op args)
"Check if this is one of mine, and do the rewrite, otherwise pass"
(ignore-errors
(let ((body (cddr op)))
(if (and (= (length body) 1)
(consp (car body))
(eq (caar body) 'jss::invoke-restargs-experimental))
(precompile-function-call `(jss::invoke-restargs-experimental ,(second (car body)) ,(car args) ,(cdr args) ,(fifth (car body)) t))
nil))))
[3]
(defmacro invoke-restargs-experimental (&whole form method object args &optional (raw? nil) (precompile nil))
"If I'm precompiling then I can do the transformation. If not I revert to the original method"
(if precompile
(if (and (consp object) (eq (car object) 'quote))
(let ((object (eval object)))
(let* ((object-as-class-name
(if (symbolp object)
(maybe-resolve-class-against-imports object)
))
(object-as-class
(if object-as-class-name (find-java-class object-as-class-name))))
(cl-user::print-db object object-as-class-name object-as-class)
(if raw?
`(jstatic-raw ,method ,object-as-class ,@args)
`(jstatic ,method ,object-as-class ,@args))))
(if raw?
`(if (symbolp ,object)
(jstatic-raw ,method (find-java-class ,object) ,@args)
(jcall-raw ,method ,object ,@args))
`(if (symbolp ,object)
(jstatic ,method (find-java-class ,object) ,@args)
(jcall ,method ,object ,@args))))
`(invoke-restargs ,method ,object ,args ,raw?)))