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

#1".." reader for more complicated java expressions, using javaparser #52

Closed
wants to merge 3 commits into
base: master
from
Jump to file or symbol
Failed to load files and symbols.
+94 −0
Diff settings

Always

Just for now

Viewing a subset of changes. View all

Utility for jss

  • Loading branch information...
alanruttenberg committed Jun 8, 2017
commit 987c18f0c50152f1bf7dfa2318660f85575cfd81
@@ -0,0 +1,94 @@
(in-package :jss)
(defclass sharp-quote-expression-reader (javaparser) ())
(defun read-sharp-java-expression (stream)
(read-sharp-quote-expression
(with-output-to-string (s)
(loop with embedded-string = nil
for last = #\space then char
for char = (read-char stream)
until (and (char= char #\")
;; really end if: we've established embedded string and the peek is a space
;; we're not about to start embedded string. We're about to start embedded string if next character isn't #\).
;; we're not embedded-string and not about to start one
(cond ((null (peek-char nil stream nil)) t) ;; eof
(embedded-string (system:whitespacep (peek-char nil stream))) ; embedded " needs "<space>" to end
((find last ",(+=" :test 'char=)
(setq embedded-string t)
nil)
(t t)))
do
(write-char char s)))))
(defun read-sharp-quote-expression (string)
(multiple-value-bind (bindings de-lisped) (extract-lisp-expressions string)
(let ((read (read-java-expression (make-instance 'sharp-quote-expression-reader) de-lisped)))
(loop for (var nil) in bindings
do (setq read (cl-user::tree-replace (lambda(e) (if (equalp e (string var)) var e)) read )))
(if bindings
`(let ,bindings ,read)
read))))
(defun extract-lisp-expressions (string)
(let ((bindings nil))
(let ((de-lisped
(cl-user::replace-all string "\\{(.*?)\\}"
(lambda(match)
(let ((replacevar (find-symbol-not-matching string (mapcar 'car bindings))))
(push (list replacevar (read-from-string match)) bindings)
(string replacevar)))
1)))
(values bindings de-lisped))))
(defun find-symbol-not-matching (string already)
(loop for candidate = (format nil "JSS_~a" (random 10000))
until (and (not (member candidate already :test 'equalp :key 'string))
(not (search string already)))
finally (return-from find-symbol-not-matching (intern candidate :jss))))
(defun maybe-class (el)
(if (and (symbolp el) (upper-case-p (char (string el) 0)) (not (eql (search "JSS_" (string el)) 0)))
`(find-java-class ',el)
(if (symbolp el)
(intern (string-upcase el) :jss)
el)))
(def-java-read ObjectCreationExpr sharp-quote-expression-reader ()
`(new ',(process-node obj (#"getName" (#"getType" node))) ,@(mapcar (lambda(e) (process-node obj e)) (j2list (#"getArguments" node))))
)
(def-java-read MethodCallExpr sharp-quote-expression-reader ()
(let* ((scope1 (process-node obj (process-node obj (#"getScope" node))))
(how (if (and (symbolp scope1) (not (null scope1)) (upper-case-p (char (string scope1) 0)))
'jstatic
'jcall)))
(if (and (symbolp scope1) (not (null scope1)) (upper-case-p (char (string scope1) 0)))
(setq scope1 `',scope1))
`(,how ,(#"getIdentifier" (#"getName" node)) ,(or scope1 'this) ,@(mapcar 'maybe-class
(mapcar (lambda(el) (process-node obj el))
(j2list (#"getArguments" node)))))
))
(def-java-read FieldAccessExpr sharp-quote-expression-reader ()
(let ((scope (process-node obj (#"getScope" node))))
(if (and (symbolp scope) (upper-case-p (char (string scope) 0)))
`(get-java-field ',(process-node obj (#"getScope" node)) ,(#"getIdentifier" (#"getField" node)) t)
`(get-java-field ,(maybe-class (process-node obj (#"getScope" node))) ,(#"getIdentifier" (#"getField" node)) t))))
(def-java-read ArrayAccessExpr sharp-quote-expression-reader ()
(let ((index (process-node obj (#"getIndex" node))))
(if (symbolp index) (setq index (intern (string-upcase index))))
`(aref ,(process-node obj (#"getName" node)) ,index)))
(def-java-read ClassExpr sharp-quote-expression-reader ()
(let ((name (process-node obj (#"getName" (#"getType" node)))))
(if (eql (search "JSS_" (string name) :test 'equalp) 0)
name
`(find-java-class ',name))))
(def-java-read NameExpr sharp-quote-expression-reader ()
(process-node obj (#"getName" node)))
ProTip! Use n and p to navigate between commits in a pull request.