source: tags/1.5.0/contrib/jss/transform-to-field.lisp

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

JSS syntax for fields (Alan Ruttenberg)

<thing> is either {<lisp expression>} or a class name or abbreviation that find-java-class can use

If <thing> is a lisp expression, then it is evaluated (in the lexical environment) and used as an instance
If <thing> is a class name the result of find-java-class is used and a static field access is done.

<field> is either {<lisp expression} or string

If <field> is a lisp expression it should evaluate to a string that names a field
If <field> is a string (no quotes) it is used as the field name

eg. #"foo.bar.baz" -> (get-java-field (find-java-class 'foo.bar) "baz" t)

#"{foo}.baz" -> (get-java-field (find-java-class foo) "baz" t)

From <https://github.com/armedbear/abcl/pull/25/commits/b94639b21843c439a5bf437661446c0b65a67791>.

File size: 2.2 KB
Line 
1(in-package :jss)
2
3;; JSS syntax for fields
4;; #"<thing>.<field>"
5;;
6;; <thing> is either {<lisp expression>} or a class name or abbreviation that find-java-class can use
7;;   If <thing> is a lisp expression, then it is evaluated (in the lexical environment) and used as an instance
8;;   If <thing> is a class name the result of find-java-class is used and a static field access is done.
9;;
10;; <field> is either {<lisp expression} or string
11;;   If <field> is a lisp expression it should evaluate to a string that names a field
12;;   If <field> is a string (no quotes) it is used as the field name
13;;
14;; eg. #"foo.bar.baz" -> (get-java-field (find-java-class 'foo.bar) "baz" t)
15;;     #"{foo}.baz" -> (get-java-field (find-java-class foo) "baz" t)
16
17
18(defun jss-transform-to-field (string)
19  (let* ((pattern (#"compile" 'java.util.regex.Pattern "(.*)\\.([^.]+)$"))
20   (matcher (#"matcher" pattern string)))
21    (#"find" matcher)
22    (let ((parts (list (#"group" matcher 1) (#"group" matcher 2))))
23      (check-class-or-eval (first parts))
24      (check-field-or-eval (second parts))
25      (apply 'field-access-expression parts))))
26
27;; http://stackoverflow.com/questions/5205339/regular-expression-matching-fully-qualified-class-names
28(defun check-class-or-eval (string)
29  (assert 
30   (or (#"matches" string "^((\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+)(\\.\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)*$")
31       (#"matches" string "^\\{.+}$")) (string)
32       "inside #\"..\" expected either an abbreviated class name or an expression surrounded by {}. Found: #~s" string))
33
34(defun check-field-or-eval (string)
35  (assert (or (#"matches" string "^(\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+$")
36        (#"matches" string "^\\{.+\\}$"))
37    (string)
38    "inside #\"..\" expected either a field name or an expression surrounded by {}. Found: #~s" string))
39
40(defun field-access-expression (thing field)
41  `(get-java-field ,(if (char= (char thing 0) #\{)
42      (intern (string-upcase (subseq thing 1 (- (length thing) 1))))
43      `(load-time-value (find-java-class ,thing)))
44       ,(if (char= (char field 0) #\{)
45      (intern (string-upcase (subseq field 1 (- (length field) 1))))
46      field)
47       t))
Note: See TracBrowser for help on using the repository browser.