1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
(in-package :jss)
(defvar *inhibit-jss-optimization* nil)
;; https://mailman.common-lisp.net/pipermail/armedbear-devel/2016-October/003726.html
(precompiler::define-function-position-lambda-transform jss::invoke-restargs (arglist form args)
(declare (ignore arglist))
(unless *inhibit-jss-optimization*
(precompiler::precompile-function-call
`(jss::invoke-restargs-macro
,(second form)
,(car args) (list ,@(cdr args)) ,(fifth form)))))
(defmacro invoke-restargs-macro ( method object args &optional (raw? nil))
(assert (eq (car args) 'list))
(setq args (cdr args))
(if (and (consp object) (eq (car object) 'quote))
(let ((object (eval object)))
(let* ((object-as-class
(or (ignore-errors (let ((*muffle-warnings* t)) (find-java-class object)))
`(find-java-class ',object))))
(if raw?
`(jstatic-raw ,method ,object-as-class ,@args)
`(jstatic ,method ,object-as-class ,@args))))
(let ((objectvar (make-symbol "INVOKE-RESTARGS-ARG1")))
(if raw?
`(let ((,objectvar ,object))
(if (symbolp ,objectvar)
(jstatic-raw ,method (find-java-class ,objectvar) ,@args)
(jcall-raw ,method ,objectvar ,@args)))
`(let ((,objectvar ,object))
(if (symbolp ,objectvar)
(jstatic ,method (find-java-class ,objectvar) ,@args)
(jcall ,method ,objectvar ,@args)))))))
|
