Mucking around with compilation

[Alan Ruttenberg]

I got curious about how I might generate better code for JSS.

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.

Thanks,
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 , at args)
 `(jstatic ,method ,object-as-class , at args))))
 (if raw?
     `(if (symbolp ,object)
  (jstatic-raw ,method (find-java-class ,object) , at args)
  (jcall-raw ,method ,object , at args))
     `(if (symbolp ,object)
  (jstatic ,method (find-java-class ,object) , at args)
  (jcall ,method ,object , at args))))
      `(invoke-restargs ,method ,object ,args ,raw?)))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/armedbear-devel/attachments/20161026/9dd818a0/attachment.html>