(in-package :ccl)

(let ((*WARN-IF-REDEFINE-KERNEL* nil)
      (*warn-if-redefine* nil))

(defun update-slots (class eslotds)
  (multiple-value-bind (instance-slots class-slots)
      (extract-instance-and-class-slotds eslotds)
    (declare (ignore-if-unused class-slots))
    (let* ((new-ordering
            (let* ((v (make-array (the fixnum (length instance-slots)))))
              (dolist (e instance-slots v)
                (setf (svref v
                             (the fixnum
                               (- (%slot-definition-location e) 1)))
                      (%slot-definition-name e)))))
           (old-wrapper (%class.own-wrapper class))
           ;(old-ordering (if old-wrapper (%wrapper-instance-slots old-wrapper)))
           (new-wrapper
            (cond ((null old-wrapper)
                   (%cons-wrapper class))
                  ((and old-wrapper *update-slots-preserve-existing-wrapper*)
                   old-wrapper)
                  ;#+bad
                  ;((and (equalp old-ordering new-ordering)
                  ;      (null class-slots))
                  ; old-wrapper)
                  (t
                   (make-instances-obsolete class)
                   ;;; Is this right ?
                   #|(%class.own-wrapper class)|#
                   (%cons-wrapper class)))))
      ;;; This is a crock: structure-classes should have slots ...
      (unless (<= (the fixnum (uvsize (instance.slots class))) %class.slots)
	(setf (%class.slots class) eslotds))
      (setf (%wrapper-instance-slots new-wrapper) new-ordering
	    (%wrapper-class-slots new-wrapper) (%class-get class :class-slots)
            (%class.own-wrapper class) new-wrapper)
      (setup-slot-lookup new-wrapper eslotds))))

)