Re: new array class

[bill@cambridge.apple.com (Bill St. Clair)]

At 10:51 AM 6/23/94 -0400, bright@ENH.NIST.GOV wrote:
>Anyone know how to make a new object that amounts to an array with a few
>extra slots?  I'd like to have some lists, pathnames, etc. tag along with
>some arrays, and yet have the arrays respond normally to AREF.  I'm having
>trouble doing the usual thing because arrays do not inherit (?) from
>STANDARD-OBJECT.

I can't think of any fast-access way short of hacking MCL internals.
All non simple-vector arrays in MCL are stored as two
objects, a header vector and a vector containing the data.
I can imagine making a new array type that has additional
space in the header for those extra slots.

If you don't need blindingly fast access to the extra slots, you
can put them in a hash table (warning, untested code):

----------------------------------------------------------------------

; slotted-arrays.lisp
;
; This version doesn't support missing or unbound slots,
; but that would be easy to add.

(defvar *array-slots-table* (make-hash-table :test 'eq :weak :key))

(defun make-slotted-array (dimensions &rest options)
  (let ((array (apply 'make-array dimensions options)))
    (setf (gethash array *array-slots-table*)
          (list nil))
    array))

(defun slotted-array-p (array)
  (gethash array *array-slots-table*))

(defun array-slot-value (array slot-name)
  (let ((plist (slotted-array-p array)))
    (unless plist
      (error "~s is not a slotted array"))
    (getf (cdr plist) slot-name)))

(defun (setf array-slot-value) (value array slot-name)
  (let ((plist (slotted-array-p array)))
    (unless plist
      (error "~s is not a slotted array"))
    (setf (getf (cdr plist) slot-name) value)))