+(defun display-inspect (object stream &optional length (skip 0))
+ (multiple-value-bind (elements labels count)
+ (inspected-elements object length skip)
+ (fresh-line stream)
+ (format stream "~A" (inspected-description object))
+ (unless (or *skip-address-display*
+ (eq object *inspect-unbound-object-marker*)
+ (and (= sb-vm::n-word-bits 64) (typep object 'single-float))
+ (characterp object) (typep object 'fixnum))
+ (write-string " at #x" stream)
+ (format stream (n-word-bits-hex-format)
+ (logand (sb-kernel:get-lisp-obj-address object)
+ (lognot sb-vm:lowtag-mask))))
+ (dotimes (i count)
+ (fresh-line stream)
+ (display-labeled-element (elt elements i) (elt labels i) stream))))
+
+(defun array-label-p (label)
+ (and (consp label)
+ (stringp (cdr label))
+ (char= (char (cdr label) 0) #\[)))
+
+(defun named-or-array-label-p (label)
+ (and (consp label) (not (hex-label-p label))))
+
+(defun hex-label-p (label &optional width)
+ (and (consp label)
+ (case width
+ (32 (eq (cdr label) :hex32))
+ (64 (eq (cdr label) :hex64))
+ (t (or (eq (cdr label) :hex32)
+ (eq (cdr label) :hex64))))))
+
+(defun display-labeled-element (element label stream)
+ (cond
+ ((eq label :ellipses)
+ (format stream " ..."))
+ ((eq label :tail)
+ (format stream "tail-> ~A" (inspected-description element)))
+ ((named-or-array-label-p label)
+ (format stream
+ (if (array-label-p label)
+ "~4,' D ~A-> ~A"
+ "~4,' D ~16,1,1,'-A> ~A")
+ (car label)
+ (format nil "~A " (cdr label))
+ (inspected-description element)))
+ ((hex-label-p label 32)
+ (format stream "~4,' D-> #x~8,'0X" (car label) element))
+ ((hex-label-p label 64)
+ (format stream "~4,' D-> #x~16,'0X" (car label) element))
+ (t
+ (format stream "~4,' D-> ~A" label (inspected-description element)))))
+
+;;; THE BEGINNINGS OF AN INSPECTOR API
+;;; which can be used to retrieve object descriptions as component values/labels and also
+;;; process print length and skip selectors
+;;;
+;;; FUNCTIONS TO CONSIDER FOR EXPORT
+;;; FIND-PART-ID
+;;; COMPONENT-AT
+;;; ID-AT
+;;; INSPECTED-ELEMENTS
+;;; INSPECTED-DESCRIPTION
+;;;
+;;; will also need hooks
+;;; *inspect-start-inspection*
+;;; (maybe. Would setup a window for a GUI inspector)
+;;; *inspect-prompt-fun*
+;;; *inspect-read-cmd*
+;;;
+;;; and, either an *inspect-process-cmd*, or *inspect-display* hook
+;;; That'll depend if choose to have standardized inspector commands such that
+;;; (funcall *inspect-read-cmd*) will return a standard command that SBCL will
+;;; process and then call the *inspect-display* hook, or if the
+;;; *inspect-read-cmd* will return an impl-dependent cmd that sbcl will
+;;; send to the contributed inspector for processing and display.
+
+(defun find-part-id (object id)
+ "COMPONENT-ID can be an integer or a name of a id.
+Returns (VALUES POSITION PARTS).
+POSITION is NIL if the id is invalid or not found."
+ (let* ((parts (inspected-parts object))
+ (name (if (symbolp id) (symbol-name id) id)))
+ (values
+ (cond
+ ((and (numberp id)
+ (< -1 id (parts-count parts))
+ (not (eq (parts-seq-type parts) :bignum)))
+ id)
+ (t
+ (case (parts-seq-type parts)
+ (:named
+ (position name (the list (parts-components parts))
+ :key #'car :test #'string-equal))
+ ((:dotted-list :cyclic-list)
+ (when (string-equal name "tail")
+ (1- (parts-count parts)))))))
+ parts)))
+
+(defun component-at (parts position)
+ (let ((count (parts-count parts))
+ (components (parts-components parts)))
+ (when (< -1 position count)
+ (case (parts-seq-type parts)
+ (:dotted-list
+ (if (= position (1- count))
+ (cdr (last components))
+ (elt components position)))
+ (:cyclic-list
+ (if (= position (1- count))
+ components
+ (elt components position)))
+ (:named
+ (cdr (elt components position)))
+ (:array
+ (aref (the array components) position))
+ (:bignum
+ (bignum-component-at components position))
+ (t
+ (elt components position))))))
+
+(defun id-at (parts position)
+ (let ((count (parts-count parts)))
+ (when (< -1 position count)
+ (case (parts-seq-type parts)
+ ((:dotted-list :cyclic-list)
+ (if (= position (1- count))
+ :tail
+ position))
+ (:array
+ (array-index-string position parts))
+ (:named
+ (car (elt (parts-components parts) position)))
+ (t
+ position)))))
+
+(defun inspected-elements (object &optional length (skip 0))
+ "Returns elements of an object that have been trimmed and labeled based on
+length and skip. Returns (VALUES ELEMENTS LABELS ELEMENT-COUNT)
+where ELEMENTS and LABELS are vectors containing ELEMENT-COUNT items.
+LABELS elements may be a string, number, cons pair, :tail, or :ellipses.
+This function may return an ELEMENT-COUNT of up to (+ 3 length) which would
+include an :ellipses at the beginning, :ellipses at the end,
+and the last element."
+ (let* ((parts (inspected-parts object))
+ (print-length (if length length (parts-count parts)))
+ (last-part (last-part parts))
+ (last-requested (last-requested parts print-length skip))
+ (element-count (compute-elements-count parts print-length skip))
+ (first-to (if (first-element-ellipses-p parts skip) 1 0))
+ (elements (when (plusp element-count) (make-array element-count)))
+ (labels (when (plusp element-count) (make-array element-count))))
+ (when (plusp element-count)
+ ;; possible first ellipses
+ (when (first-element-ellipses-p parts skip)
+ (set-element-values elements labels 0 nil :ellipses))
+ ;; main elements
+ (do* ((i 0 (1+ i)))
+ ((> i (- last-requested skip)))
+ (set-element elements labels parts (+ i first-to) (+ i skip)))
+ ;; last parts value if needed
+ (when (< last-requested last-part)
+ (set-element elements labels parts (- element-count 1) last-part))
+ ;; ending ellipses or next to last parts value if needed
+ (when (< last-requested (1- last-part))
+ (if (= last-requested (- last-part 2))
+ (set-element elements labels parts (- element-count 2) (1- last-part))
+ (set-element-values elements labels (- element-count 2) nil :ellipses))))
+ (values elements labels element-count)))
+
+(defun last-requested (parts print skip)
+ (min (1- (parts-count parts)) (+ skip print -1)))
+
+(defun last-part (parts)
+ (1- (parts-count parts)))
+
+(defun compute-elements-count (parts length skip)
+ "Compute the number of elements in parts given the print length and skip."
+ (let ((element-count (min (parts-count parts) length
+ (max 0 (- (parts-count parts) skip)))))
+ (when (and (plusp (parts-count parts)) (plusp skip)) ; starting ellipses
+ (incf element-count))
+ (when (< (last-requested parts length skip)
+ (last-part parts)) ; last value
+ (incf element-count)
+ (when (< (last-requested parts length skip)
+ (1- (last-part parts))) ; ending ellipses
+ (incf element-count)))
+ element-count))
+
+(defun set-element (elements labels parts to-index from-index)
+ (set-element-values elements labels to-index (component-at parts from-index)
+ (label-at parts from-index)))
+
+(defun set-element-values (elements labels index element label)
+ (setf (aref elements index) element)
+ (setf (aref labels index) label))
+
+(defun first-element-ellipses-p (parts skip)
+ (and (parts-count parts) (plusp skip)))
+
+(defun label-at (parts position)
+ "Helper function for inspected-elements. Conses the
+position with the label if the label is a string."
+ (let ((id (id-at parts position)))