Commit 83cba3fb by Alan Ruttenberg

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)
parent 96203e39
......@@ -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)
......
(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 ba 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 ba "foo" t))
(is-error (read-from-string "#\".bar.foo\"") 'simple-error)
(finalize)
;;;; -*- Mode: LISP -*-
(in-package :asdf)
(asdf:defsystem :jss
:author "Alan Ruttenberg, Mark Evenson"
:version "3.2.1"
......@@ -9,7 +9,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)))
......
(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))))
(print parts)
(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) 2))))
`(load-time-value (find-java-class ,thing)))
,(if (char= (char field 0) #\{)
(intern (string-upcase (subseq field 1 (- (length field) 1))))
field)
t))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment