-(defun expand-container-type (type-number &optional slots)
- (let* ((class (type-from-number type-number))
- (super (supertype type-number))
- (child-class (default-container-child-name class))
- (expanded-child-slots
- (mapcar
- #'(lambda (param)
- (with-slots (name flags value-type documentation) param
- (let* ((slot-name (default-slot-name name))
- (slot-type (type-from-number value-type #|t|#))
- (accessor
- (default-slot-accessor class slot-name slot-type)))
- `(,slot-name
- :allocation :property
- :pname ,name
- ,@(cond
- ((and
- (member :writable flags)
- (member :readable flags))
- (list :accessor accessor))
- ((member :writable flags)
- (list :writer `(setf ,accessor)))
- ((member :readable flags)
- (list :reader accessor)))
- ,@(when (or
- (member :construct flags)
- (member :writable flags))
- (list :initarg (intern (string slot-name) "KEYWORD")))
- :type ,slot-type
- ,@(when documentation
- (list :documentation documentation))))))
- (query-container-class-child-properties type-number))))
+(defun expand-container-type (type &optional options)
+ (let* ((class (type-from-number type))
+ (super (supertype type))
+ (child-class (default-container-child-name class)))