source: tags/1.5.0/contrib/jss/optimize-java-call.lisp

Last change on this file was 14911, checked in by Mark Evenson, 7 years ago

precompiler: possibly beta reduce form with function position lambda (Alan Ruttenberg)

Case 1: If the lambda has a single form in it, let someone define a
transform using:

define-function-position-lambda-transform (body-function-name (arglist form args) &body body)

body-function-name is the car of the single form in the lambda
arglist is the arglist of the lambda
form is the single form within the lambda
args are the arguments to which the lambda will be defined.

The function should check whether it can do a transform, and do it if
so, otherwise return nil signalling it couldn't

Case 2: If case 1 is not successful then if the arglist is a simple
one (no &key, &rest, &optional) then do a standard beta-reduction
binding the args to arglist using let (​https://wiki.haskell.org/Beta_reduction)

If not, return and do the usual thing.

An example is in contrib/jss/optimize-java-call.lisp

To see benefits, (compile-file contrib/jss/test-optimize-java-call.lisp)
and then load the compiled file. You should see something like the below
which reports the timings for the optimized and unoptimized version of
10000 calls of (#"compile" 'regex.pattern ".*")

--

With optimization: (INVOKE-RESTARGS-MACRO "compile" (QUOTE REGEX.PATTERN) (LIST ".*") NIL T)
Without optimization: ((LAMBDA (#:G85648 &REST #:G85649) (INVOKE-RESTARGS "compile" #:G85648 #:G85649 NIL)) (QUOTE REGEX.PATTERN) ".*")

JUST-LOOP
0.0 seconds real time
0 cons cells

OPTIMIZED-JSS
0.011 seconds real time
0 cons cells

UNOPTIMIZED-JSS
0.325 seconds real time
800156 cons cells

---
<> rdfs:seeAlso <​https://mailman.common-lisp.net/pipermail/armedbear-devel/2016-October/003726.html>
<> rdfs:seeAlso <​https://mailman.common-lisp.net/pipermail/armedbear-devel/2016-November/003733.html> .
<> :fixes <​https://mailman.common-lisp.net/pipermail/armedbear-devel/2016-November/003736.html> .
<> :closes <​https://github.com/armedbear/abcl/pull/11/files> .
<> :closes <​http://abcl.org/trac/ticket/420> .
File size: 1.2 KB
Line 
1(in-package :jss)
2
3(defvar *inhibit-jss-optimization* nil)
4
5;; https://mailman.common-lisp.net/pipermail/armedbear-devel/2016-October/003726.html
6
7(precompiler::define-function-position-lambda-transform jss::invoke-restargs (arglist form args)
8  (declare (ignore arglist))
9  (unless *inhibit-jss-optimization*
10    (precompiler::precompile-function-call 
11     `(jss::invoke-restargs-macro
12    ,(second form)
13    ,(car args) (list ,@(cdr args)) ,(fifth form)))))
14
15(defmacro invoke-restargs-macro ( method object args &optional (raw? nil))
16  (assert (eq (car args) 'list))
17  (setq args (cdr args))
18  (if (and (consp object) (eq (car object) 'quote))
19      (let ((object (eval object)))
20  (let* ((object-as-class
21     (or (ignore-errors (let ((*muffle-warnings* t)) (find-java-class object)))
22         `(find-java-class ',object))))
23    (if raw?
24        `(jstatic-raw ,method ,object-as-class ,@args)
25        `(jstatic ,method ,object-as-class ,@args))))
26      (if raw?
27    `(if (symbolp ,object)
28         (jstatic-raw ,method (find-java-class ,object) ,@args)
29         (jcall-raw ,method ,object ,@args))
30    `(if (symbolp ,object)
31         (jstatic ,method (find-java-class ,object) ,@args)
32         (jcall ,method ,object ,@args)))))
33
34
35
Note: See TracBrowser for help on using the repository browser.