source: trunk/abcl/contrib/jss/transform-to-field.lisp @ 15087

Last change on this file since 15087 was 15087, checked in by mevenson, 2 months ago

jss: optimizations for jss field accessors
(Alan Ruttenberg)

Including '==' scope for one-only lookup of fields.

Revised doc at top of transform-to-field.lisp.

From <https://github.com/armedbear/abcl/pull/56>.

Merges
<https://github.com/armedbear/abcl/pull/56/commits/382a6db1ad5ac6685e97ad3677cc1681a12bc0f7>.

File size: 4.5 KB
Line 
1(in-package :jss)
2
3;; JSS syntax for fields
4;; #"[<scope>]<thing>.<field>"
5;;
6;; <scope> is empty or "==". scope is only paid attention to when <field> is a literal string
7;;
8;; <thing> is either {<lisp expression>} or a class name or abbreviation that find-java-class can use
9;;   If <thing> is a lisp expression, then it is evaluated (in the lexical environment) and used as an instance
10;;     when <scope> is "==" you promise that instance will always be of the same class, and so field lookup
11;;     is done once and cached.
12;;   If <thing> is a class name the result of find-java-class is used and a static field access is done.
13;;     when <scope> is "==" you promise the static field is final and so the result is wrapped in (load-time-value  ...)
14;;
15;; <field> is either {<lisp expression} or string
16;;   If <field> is a lisp expression it should evaluate to a string that names a field
17;;   If <field> is a string (no quotes) it is used as the field name
18;;
19;; eg. #"foo.bar.baz" -> (get-java-field (find-java-class 'foo.bar) "baz" t)
20;;     #"{foo}.baz" -> (get-java-field (find-java-class foo) "baz" t)
21;;     #"==foo.baz" -> (load-time-value (get-java-field (find-java-class "foo") "bar" t))
22;;     #"=={foo}.baz" -> TL;DR (only look up baz field once based on class of foo, and cache)
23
24(defun jss-transform-to-field (string sharp-arg)
25  (let* ((pattern (#"compile" 'java.util.regex.Pattern "((==){0,1})(.*)\\.([^.]+)$"))
26   (matcher (#"matcher" pattern string)))
27    (#"find" matcher)
28    (let ((parts (list (#"group" matcher 3) (#"group" matcher 4)))
29    (scope (#"group" matcher 1)))
30      (check-class-or-eval (first parts))
31      (check-field-or-eval (second parts))
32      (apply 'field-access-expression sharp-arg scope parts ))))
33
34;; http://stackoverflow.com/questions/5205339/regular-expression-matching-fully-qualified-class-names
35(defun check-class-or-eval (string)
36  (assert 
37   (or (#"matches" string "^((\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+)(\\.\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)*$")
38       (#"matches" string "^\\{.+}$")) (string)
39       "inside #\"..\" expected either an abbreviated class name or an expression surrounded by {}. Found: #~s" string))
40
41(defun check-field-or-eval (string)
42  (assert (or (#"matches" string "^(\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+$")
43        (#"matches" string "^\\{.+\\}$"))
44    (string)
45    "inside #\"..\" expected either a field name or an expression surrounded by {}. Found: #~s" string))
46
47(defun field-access-expression (sharp-arg scope thing field )
48  (if (and (not (char= (char thing 0) #\{)) (not (char= (char field 0) #\{)))
49      (static-field-ref-transform thing field sharp-arg scope)
50      (if (and (equal scope "==") (char= (char thing 0) #\{) (not (char= (char field 0) #\{)))
51    (always-same-signature-field-ref-transform sharp-arg thing field)
52    `(get-java-field ,(if (char= (char thing 0) #\{)
53        (read-from-string (subseq thing 1 (- (length thing) 1)))
54        `(load-time-value (find-java-class ,thing)))
55         ,(if (char= (char field 0) #\{)
56        (read-from-string (subseq field 1 (- (length field) 1)))
57        field)
58         t))))
59
60;; If a class name and explicit field name we can look everything up at load time
61(defun static-field-ref-transform (class field sharp-arg scope)
62  (if (equal scope "==")
63      `(load-time-value (get-java-field (find-java-class ,class) ,field t))
64      `(,(if (eql sharp-arg 0) 'jcall-raw 'jcall) 
65  (load-time-value (jmethod "java.lang.reflect.Field" "get" "java.lang.Object"))
66  (load-time-value 
67   (let ((jfield (find-declared-field ,field (find-java-class ,class))))
68     (#"setAccessible" jfield t)
69     jfield))
70  (load-time-value (find-java-class ',class)))))
71
72;; 1 case: =={var}.foo
73;; Globally cache the field accessor for the first value of {var}. Subsequent calls ignore the class of var.
74(defun always-same-signature-field-ref-transform (sharp-arg object field)
75  (let ((cached (make-symbol (format nil "CACHED-FIELD-field")))
76  (object (intern (string-upcase (subseq object 1 (- (length object) 1))))))
77    `(,(if (eql sharp-arg 0) 'jcall-raw 'jcall)
78      (load-time-value (jmethod "java.lang.reflect.Field" "get" "java.lang.Object"))
79      (locally (declare (special ,cached))
80  (if (boundp ',cached)
81      ,cached
82      (progn (setq ,cached 
83       (find-declared-field ,field (jcall (load-time-value (jmethod "java.lang.Object" "getClass")) ,object)))
84       (jcall (load-time-value (jmethod "java.lang.reflect.Field" "setAccessible" "boolean")) ,cached t)
85       ,cached)))
86      ,object)))
87
88
89
90
91
92 
Note: See TracBrowser for help on using the repository browser.