-(defmethod validate-superclass
- ((class boxed-class) (super pcl::standard-class))
- (subtypep (class-name super) 'boxed))
+(defmethod shared-initialize ((class boxed-class) names
+ &key name gtype ref unref)
+ (declare (ignore names))
+ (let* ((class-name (or name (class-name class)))
+ (type-number
+ (register-type class-name
+ (or
+ (first gtype)
+ (default-type-init-name class-name)))))
+ (unless (or ref (slot-boundp class 'ref))
+ (setf
+ (slot-value class 'ref)
+ #'(lambda (location)
+ (%boxed-copy type-number location))))
+ (unless (or unref (slot-boundp class 'unref))
+ (setf
+ (slot-value class 'unref)
+ #'(lambda (location)
+ (%boxed-free type-number location)))))
+ (call-next-method))
+
+
+(defun expand-boxed-type (type-number forward-p slots)
+ `(defclass ,(type-from-number type-number) (boxed)
+ ,(unless forward-p
+ slots)
+ (:metaclass boxed-class)
+ (:gtype ,(register-type-as type-number))))