| 1 | (in-package :jss) |
|---|
| 2 | |
|---|
| 3 | (defvar *class-to-last-component* (make-hash-table :test 'equalp)) |
|---|
| 4 | |
|---|
| 5 | (defclass javaparser () ()) |
|---|
| 6 | |
|---|
| 7 | (defmacro def-java-read (ast-class class fields &body body) |
|---|
| 8 | (let ((jclass (find-java-class (concatenate 'string "com.github.javaparser.ast.expr." (string ast-class))))) |
|---|
| 9 | `(progn |
|---|
| 10 | (setf (gethash ,jclass *class-to-last-component*) ',ast-class) |
|---|
| 11 | (defmethod ,ast-class ((obj ,class) node &optional |
|---|
| 12 | ,@(loop for field in fields |
|---|
| 13 | collect `(,(intern (string-upcase field)) (get-java-field node ,field t)))) |
|---|
| 14 | ,@body)))) |
|---|
| 15 | |
|---|
| 16 | (defvar *object-for-this* (new 'lang.object)) |
|---|
| 17 | |
|---|
| 18 | (defmethod get-optional ((r javaparser) node) |
|---|
| 19 | (if (equal node (load-time-value (#"empty" 'java.util.Optional ))) nil (#"get" node))) |
|---|
| 20 | |
|---|
| 21 | (defmethod process-node ((r javaparser) node) |
|---|
| 22 | (when (jinstance-of-p node "java.util.Optional") |
|---|
| 23 | (setq node (get-optional r node))) |
|---|
| 24 | (when (null node) |
|---|
| 25 | (return-from process-node nil)) |
|---|
| 26 | (if (java-object-p node) |
|---|
| 27 | (funcall (gethash (jobject-class node) *class-to-last-component*) r node) |
|---|
| 28 | node)) |
|---|
| 29 | |
|---|
| 30 | (defmethod read-java-expression ((r javaparser) expression) |
|---|
| 31 | `(let ((this *object-for-this*)) |
|---|
| 32 | ,(process-node r (#"parseExpression" 'javaparser expression)))) |
|---|
| 33 | |
|---|
| 34 | (def-java-read LongLiteralExpr javaparser () |
|---|
| 35 | (read-from-string (#"replaceFirst" (#"getValue" node) "L" ""))) |
|---|
| 36 | |
|---|
| 37 | (def-java-read BooleanLiteralExpr javaparser () |
|---|
| 38 | (if (equal (#"getValue" node) "true") t nil)) |
|---|
| 39 | |
|---|
| 40 | (def-java-read IntegerLiteralExpr javaparser nil |
|---|
| 41 | (parse-integer (#"getValue" node))) |
|---|
| 42 | |
|---|
| 43 | (def-java-read DoubleLiteralExpr javaparser nil |
|---|
| 44 | (let ((raw (#"getValue" node))) |
|---|
| 45 | (setq raw (#"replaceAll" raw "_" "")) |
|---|
| 46 | (if (#"matches" raw ".*[dD]$") |
|---|
| 47 | (read-from-string (#"replaceFirst" (subseq raw 0 (1- (length raw))) "e" "d")) |
|---|
| 48 | (if (#"matches" raw ".*[fF]$") |
|---|
| 49 | (read-from-string (subseq raw 0 (1- (length raw)))) |
|---|
| 50 | (read-from-string raw))))) |
|---|
| 51 | |
|---|
| 52 | (def-java-read CharLiteralExpr javaparser nil |
|---|
| 53 | (#"getValue" node)) |
|---|
| 54 | |
|---|
| 55 | (def-java-read StringLiteralExpr javaparser nil |
|---|
| 56 | (#"getValue" node)) |
|---|
| 57 | |
|---|
| 58 | (def-java-read NullLiteralExpr javaparser nil |
|---|
| 59 | +null+) |
|---|
| 60 | |
|---|
| 61 | (def-java-read SimpleName javaparser () |
|---|
| 62 | (let ((symbol (intern (#"getIdentifier" node)))) |
|---|
| 63 | symbol)) |
|---|
| 64 | |
|---|
| 65 | (eval-when (:compile-toplevel :load-toplevel :execute) |
|---|
| 66 | (defun read-invoke/javaparser (stream char arg) |
|---|
| 67 | (if (eql arg 1) |
|---|
| 68 | |
|---|
| 69 | (if (ignore-errors |
|---|
| 70 | (jclass "com.github.javaparser.ParseStart")) ;; chosen randomly, TODO memoize |
|---|
| 71 | (read-sharp-java-expression stream) |
|---|
| 72 | ;; Deal with possiblity of not loading jar |
|---|
| 73 | (error "Cannot load javaparser code needed for the #1 macro")) |
|---|
| 74 | (read-invoke stream char arg))) |
|---|
| 75 | (set-dispatch-macro-character #\# #\" 'read-invoke/javaparser)) |
|---|
| 76 | |
|---|
| 77 | |
|---|
