bug in 3-17-88 pcl, compute-effective-slotd

[Gregor.pa@Xerox.COM]

    Date: Tue, 22 Mar 88 17:31:08 PST
    From: jam@entropy.ms.washington.edu (John Alan McDonald)

    ;;; -*- Package: PCL; Mode: Lisp; Syntax: Common-Lisp; -*-


    ;;; In PCL version 3-17-88, Symbolics Genera 7.1,
    ;;; apparant bug in compute-effective-slotd
    ;; the following bombs:

    (defclass class1 () (x))
    (defclass class2 (class1) ((x :type number)))

The following patch fixes this problem.  Everyone should install this
patch in their std-class.lisp file.  It replaces the existing definition
of compute-effective-slotd.

; from std-class.lisp
(defmethod COMPUTE-EFFECTIVE-SLOTD ((class standard-class) slotds)
  (let* ((unsupplied *slotd-unsupplied*)
	 (name unsupplied)
	 (keyword unsupplied)
	 (initfunction unsupplied)
	 (initform unsupplied)
	 (initargs nil)
	 (allocation unsupplied)
	 (type unsupplied)
	 (accessors (and (car slotds)
			 (slotd-accessors (car slotds))))
	 (readers   (and (car slotds)
			 (slotd-readers (car slotds)))))

    (dolist (slotd slotds)
      (when slotd
	(when (eq name unsupplied)
	  (setq name (slotd-name slotd)
		keyword (slotd-keyword slotd)))
	(when (eq initform unsupplied)
	  (setq initform (slotd-initform slotd))
	  (setq initfunction (slotd-initfunction slotd)))
	(when (eq allocation unsupplied)
	  (setq allocation (slotd-allocation slotd)))
	(setq initargs (append (slotd-initargs slotd) initargs))
	(let ((slotd-type (slotd-type slotd)))
	  (setq type (cond ((eq type unsupplied) slotd-type)
			   ((eq slotd-type unsupplied) type)
			   ((subtypep type slotd-type) type)
			   (t `(and ,type ,slotd-type)))))))
    
    (when (eq initform unsupplied)
      (setq initfunction nil))
    (when (eq type unsupplied)
      (setq type 't))
    (when (eq allocation unsupplied)
      (setq allocation :instance))
    
    (make-slotd class
		:name name
		:keyword keyword
		:initform initform
		:initfunction initfunction
		:initargs initargs
		:allocation allocation
		:type type
		:accessors accessors
		:readers readers)))
-------