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.")))))