New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

JSS syntax for fields #25

Closed
wants to merge 3 commits into
from
Jump to file or symbol
Failed to load files and symbols.
+91 −6
Diff settings

Always

Just for now

Next

JSS syntax for fields

<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)
  • Loading branch information...
alanruttenberg committed Jan 13, 2017
commit b94639b21843c439a5bf437661446c0b65a67791
View
@@ -207,10 +207,12 @@ NAME can either string or a symbol according to the usual JSS conventions."
(defun read-invoke (stream char arg)
(unread-char char stream)
(let ((name (read stream)))
(let ((object-var (gensym))
(args-var (gensym)))
`(lambda (,object-var &rest ,args-var)
(invoke-restargs ,name ,object-var ,args-var ,(eql arg 0))))))
(if (or (find #\. name) (find #\{ name))
(jss-transform-to-field name)
(let ((object-var (gensym))
(args-var (gensym)))
`(lambda (,object-var &rest ,args-var)
(invoke-restargs ,name ,object-var ,args-var ,(eql arg 0)))))))
(set-dispatch-macro-character #\# #\" 'read-invoke))
(defmacro with-constant-signature (fname-jname-pairs &body body)
View
@@ -0,0 +1,14 @@
(in-package :cl-user)
(defpackage jss-test
(:use :cl :cl-user :jss :prove))
(in-package :jss-test)
(plan 4)
(is (read-from-string "#\"{bar}.{foo}\"") '(get-java-field bar foo t))
(is (read-from-string "#\"q.bar.{foo}\"") '(get-java-field (load-time-value (find-java-class "q.bar")) foo t))
(is (read-from-string "#\"{bar}.foo\"") '(get-java-field bar "foo" t))
(is-error (read-from-string "#\".bar.foo\"") 'simple-error)
(finalize)
View
@@ -1,4 +1,4 @@
;;;; -*- Mode: LISP -*-
(in-package :asdf)
(asdf:defsystem :jss
:author "Alan Ruttenberg, Mark Evenson"
:version "3.3.0"
@@ -10,7 +10,29 @@
(:file "collections")
(:file "optimize-java-call")
(:file "classpath")
(:file "compat")))))
(:file "transform-to-field")
(:file "compat")
)))
;; :defsystem-depends-on (:prove-asdf)
;; :in-order-to ((test-op (test-op jss/tests)))
)
;; Until prove-asdf works
(let ((where (merge-pathnames "jss-tests.lisp" (load-time-value *load-pathname*))))
(defun cl-user::test-jss()
(funcall (intern "QUICKLOAD" 'ql) :prove)
(funcall (intern "RUN" 'prove) where)))
;; (asdf:defsystem :jss/tests
;; :depends-on (jss)
;; :components ((:module tests
;; :pathname ""
;; :components ((:test-file "jss-tests"))
;; ))
;; :perform (test-op :after (op c)
;; (funcall (intern #.(string :run) :prove) c)))
@@ -0,0 +1,47 @@
(in-package :jss)
;; JSS syntax for fields
;; #"<thing>.<field>"
;;
;; <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)
(defun jss-transform-to-field (string)
(let* ((pattern (#"compile" 'java.util.regex.Pattern "(.*)\\.([^.]+)$"))
(matcher (#"matcher" pattern string)))
(#"find" matcher)
(let ((parts (list (#"group" matcher 1) (#"group" matcher 2))))
(check-class-or-eval (first parts))
(check-field-or-eval (second parts))
(apply 'field-access-expression parts))))
;; http://stackoverflow.com/questions/5205339/regular-expression-matching-fully-qualified-class-names
(defun check-class-or-eval (string)
(assert
(or (#"matches" string "^((\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+)(\\.\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)*$")
(#"matches" string "^\\{.+}$")) (string)
"inside #\"..\" expected either an abbreviated class name or an expression surrounded by {}. Found: #~s" string))
(defun check-field-or-eval (string)
(assert (or (#"matches" string "^(\\p{javaJavaIdentifierStart}(\\p{javaJavaIdentifierPart})*)+$")
(#"matches" string "^\\{.+\\}$"))
(string)
"inside #\"..\" expected either a field name or an expression surrounded by {}. Found: #~s" string))
(defun field-access-expression (thing field)
`(get-java-field ,(if (char= (char thing 0) #\{)
(intern (string-upcase (subseq thing 1 (- (length thing) 1))))
`(load-time-value (find-java-class ,thing)))
,(if (char= (char field 0) #\{)
(intern (string-upcase (subseq field 1 (- (length field) 1))))
field)
t))