jss: new macro WITH-CLASS-LOOKUP-DISAMBIGUATED

(Alan Ruttenberg)

(with-class-lookup-disambiguated (lang.object) (find-java-class 'object))
    -> success (otherwise error: ambiguous)

From <https://github.com/armedbear/abcl/pull/57>.

Merges
<https://github.com/armedbear/abcl/pull/57/commits/5103d57822691d74c66b80c754f8438df6806bba>.
parent 31d55046
......@@ -245,10 +245,28 @@ want to avoid the overhead of the dynamic dispatch."
(with-constant-signature ,(cdr fname-jname-pairs)
,@body)))))))
(defvar *class-lookup-overrides*)
(defmacro with-class-lookup-disambiguated (overrides &body body)
"Suppose you have code that references class using the symbol 'object, and this is ambiguous. E.g. in my system java.lang.Object, org.omg.CORBA.Object. Use (with-class-lookup-disambiguated (lang.object) ...). Within dynamic scope, find-java-class first sees if any of these match, and if so uses them to lookup the class."
`(let ((*class-lookup-overrides* ',overrides))
,@body))
(defun maybe-found-in-overridden (name)
(when (boundp '*class-lookup-overrides*)
(let ((found (find-if (lambda(el) (#"matches" (string el) (concatenate 'string "(?i).*" (string name) "$")))
*class-lookup-overrides*)))
(if found
(let ((*class-lookup-overrides* nil))
(lookup-class-name found))))))
(defun lookup-class-name (name &key
(table *class-name-to-full-case-insensitive*)
(muffle-warning nil)
(return-ambiguous nil))
(let ((overridden (maybe-found-in-overridden name)))
(when overridden (return-from lookup-class-name overridden)))
(setq name (string name))
(let* (;; cant (last-name-pattern (#"compile" '|java.util.regex.Pattern| ".*?([^.]*)$"))
;; reason: bootstrap - the class name would have to be looked up...
......
(in-package :cl-user)
(prove:plan 6)
(prove:plan 8)
(prove:is
(read-from-string "#\"{bar}.{foo}\"")
......@@ -22,7 +22,16 @@
(prove:is (#"toString"
(find "size" (#"getMethods" (find-java-class "java.util.Collections$UnmodifiableMap"))
:test 'string-equal :key #"getName"))
(#"toString" (java::jmethod "java.util.Collections$UnmodifiableMap" "size" )))
(#"toString" (java::jmethod "java.util.Collections$UnmodifiableMap" "size" )))
(prove:is
(jss::with-class-lookup-disambiguated (lang.object) (find-java-class 'object))
(find-java-class 'java.lang.object))
;; Object is ambiguous in default java
(prove:is-error
(find-java-class 'object)
'simple-error)
;; test that optimized jss is much faster than unoptimized
(let ()
......
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