[comp.lang.lisp] KCl Inspector?

eliot@phoenix.Princeton.EDU (Eliot Handelman) (08/16/89)

Has anyone hacked together a reasonable inspector for KCl? The built-in
inpsector doesn't allow the inspection of structure slots, array slots, 
the recursive inspection of nested structure, and much, much more.

harrisr@cs.rpi.edu (Richard Harris) (09/07/89)

In article <9501@phoenix.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:
>Has anyone hacked together a reasonable inspector for KCl? The built-in
>inpsector doesn't allow the inspection of structure slots, array slots, 
>the recursive inspection of nested structure, and much, much more.

The built-in inspector already allows the inspection of vectors.

To allow it to inspect structures, make these changes to describe.lsp:

bach.cs.rpi.edu[12]: diff -c4 /us2/src/kcl/lsp/describe.lsp describe.lsp
*** /us2/src/kcl/lsp/describe.lsp	Thu Jun  4 03:08:05 1987
--- describe.lsp	Sun Nov  6 21:39:35 1988
***************
*** 263,270 ****
--- 263,298 ----
    (inspect-print "rank:  ~D" (array-rank array))
    (inspect-print "dimensions:  ~D" (array-dimensions array))
    (inspect-print "total size:  ~D" (array-total-size array)))
  
+ (defvar *enable-pcl-describe* t)
+ 
+ (defsetf structure-ref structure-set)
+ 
+ (defun inspect-structure (structure &aux (name (structure-name structure)) pcl fun)
+   (if (and *enable-pcl-describe*
+ 	   (setq pcl (find-package "PCL"))
+ 	   (setq fun (find-symbol (if *inspect-mode* "INSPECT-INSTANCE" "DESCRIBE-INSTANCE") pcl))
+ 	   (fboundp fun)	
+ 	   (eq name (intern "IWMC-CLASS" pcl)))	; don't bother with other metaclasses
+       (funcall fun structure)
+       (progn
+ 	(if (get name 'structure-print-function)
+ 	    (format t "~S - ~S" structure name)
+ 	    (format t "#<structure ~8,'0X> ~S" (address structure) name))
+ 	(let ((slotds (get name 'structure-slot-descriptions)))
+ 	  (dolist (slotd slotds)
+ 	    (if *inspect-mode*
+ 		(inspect-recursively (format nil "~S:" (car slotd))
+ 				     (structure-ref structure name (fifth slotd))
+ 				     (structure-ref structure name (fifth slotd)))
+ 		(inspect-print (format nil "~S:  ~~S" (car slotd))
+ 			       (structure-ref structure name (fifth slotd))
+ 			       (structure-ref structure name (fifth slotd)))))))))
+ 
+ (defun inspect-other (object)
+   (format t "~S - ~S" object (type-of object)))
+ 
  (defun inspect-object (object &aux (*inspect-level* *inspect-level*))
    (inspect-indent)
    (when (and (not *inspect-mode*)
               (or (> *inspect-level* 5)
***************
*** 281,296 ****
                 ((consp object) (inspect-cons object))
                 ((stringp object) (inspect-string object))
                 ((vectorp object) (inspect-vector object))
                 ((arrayp object) (inspect-array object))
!                (t (format t "~S - ~S" object (type-of object))))))
  
- 
  (defun describe (object &aux (*inspect-mode* nil)
                               (*inspect-level* 0)
                               (*inspect-history* nil)
!                              (*print-level* nil)
!                              (*print-length* nil))
    "The lisp function DESCRIBE."
    (terpri)
    (catch 'quit-inspect (inspect-object object))
    (terpri)
--- 309,325 ----
                 ((consp object) (inspect-cons object))
                 ((stringp object) (inspect-string object))
                 ((vectorp object) (inspect-vector object))
                 ((arrayp object) (inspect-array object))
!  	       ((structurep object) (inspect-structure object))
! 	       (t (inspect-other object)))))
  
  (defun describe (object &aux (*inspect-mode* nil)
                               (*inspect-level* 0)
                               (*inspect-history* nil)
!                              ;;(*print-level* nil)
!                              ;;(*print-length* nil)
! 			     )
    "The lisp function DESCRIBE."
    (terpri)
    (catch 'quit-inspect (inspect-object object))
    (terpri)
bach.cs.rpi.edu[13]: