New subject: precompiler work (was Re: Mucking around with compilation)

26 Oct 2016


      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 ,@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?)))