The 'apropos' function searches the Nyquist/XLISP *obarray* for
matching symbol names containing 'pattern' and being of 'type'.
'pattern and 'type' can be given as symbols or strings.
Examples:
|
|
|||
|
|
|||
|
|
|||
|
|
A method to introspect classes and objects:
(setq instance-var '*wrong-variable*) ; value outside the object (setq my-class (send class :new '(instance-var))) ; class with instance variable (send my-class :answer :isnew '() '((setq instance-var '*OK*))) ; value inside an object (send my-class :answer :eval '(list) '((eval list))) ; evaluation method (setq my-object (send my-class :new)) ; instance of my-class (send my-object :eval 'instance-var) => *OK* (send my-object :eval '(apropos 'instance-var 'v t)) => *WRONG-VARIABLE*
The first version works because the call to 'eval' happens inside the object:
(send my-class :answer :eval '(list) '((eval list))) => *OK*
The second version doesn't work because the call to 'eval' happens outside the object:
(defun external-function (list) (eval list)) (send my-class :answer :eval '(list) '((external-function list))) => *WRONG-VARIABLE*
The call to 'apropos' doesn't work because 'apropos' is executed outside the object:
(send my-object :eval '(apropos)) => *WRONG-VARIABLE*
The trick is to pass the Lisp code of 'apropos' as a list into the inside of the object and 'apply' it there to the arguments:
(send my-class :answer :apropos '(args) '((apply (get-lambda-expression #'apropos) args))) (send my-object :apropos '(instance-var v t)) => *OK*
But this only works if all function that need access to internal instance or class variables are executed inside the object. For example, if 'apropos' calls a function that needs access to an internal instance variable, I would get a 'unbound variable' error.
Here is the code of the 'apropos' function:
(defun apropos (&optional pattern type)
(let (result-list (*gc-flag* nil))
;; make sure 'pattern' is a string, either empty or upper-case
(if pattern
(setf pattern (string-upcase (string pattern)))
(setf pattern ""))
;; take only the first letter of 'type' and make it an upper-case string
(if type (setf type (string-upcase (subseq (string type) 0 1))))
;; go through all entries in the *obarray* symbol hash table
(dotimes (i (length *obarray*))
(let ((entry (aref *obarray* i))) ; *obarray* is an array of lists
;; if the *obarray* entry is not an empty list
(if entry
;; go through all elements of the *obarray* entry list
;; do not use 'dolist' because *obarray* contains *unbound*
(dotimes (j (length entry))
;; convert the symbol to a string to enable pattern matching
(let ((string (string (nth j entry))))
;; if the symbol string matches the search pattern
(if (string-search pattern string)
;; if a special symbol type to search for was given
(if type
;; if a 'type' search was initiated and the current
;; symbol has no 'type' value bound to it, do nothing
;; and return from 'cond' without adding the symbol
;; string to the result list
(cond ((and (string= type "F") ; bound functions only
(not (fboundp (nth j entry))))
nil)
((and (string= type "V") ; bound variables only
(not (boundp (nth j entry))))
nil)
;; if the symbol has passed all tests,
;; add the symbol string to the result list
(t (setf result-list (cons string result-list))))
;; if no special symbol type to search for had been given,
;; but the symbol string had matched the search pattern,
;; add the symbol string to the result list
(setf result-list (cons string result-list)))))))))
;; if the result list contains more than one element
;; make it become an alphabetically sorted list
(if (> (length result-list) 1)
(setf result-list (sort result-list 'string<)))
;; print a message according to the search type and pattern
(cond ((and type (string= type "F")) (setf type "function"))
((and type (string= type "V")) (setf type "variable"))
(t (setf type "symbol")))
(if (string= pattern "")
(format t "All ~a names known by Nyquist:~%" type)
(format t "All ~a names containing pattern ~a:~%" type pattern))
;; print the search results
(cond (result-list
(let ((list-length (length result-list)))
(format t ";; number of symbols: ~a~%" list-length)
(dolist (i result-list) (format t "~a~%" i))
(if (> list-length 20)
(format t ";; number of symbols: ~a~%" list-length))))
(t (format t "No matches found.")))))