🚀 go-pugleaf

There is a bug in all versions of PCL newer that March 92 PCL:

This bug affects generic functions which use dispatch dfuns, and arises
because of a bug in the proclaim-incompatible-superclasses form that
appears in methods.lisp (which in turn was "caused" by a bug in 
the definition of *built-in-classes*).

   The bug:
   >lisp
   CMU Common Lisp 16e, running on nova0.rdrc.rpi.edu
   Send bug reports and questions to your local CMU CL maintainer, or to
   cmucl-bugs@cs.cmu.edu.
   Loaded subsystems:
       Python 1.0, target SPARCstation/Sun 4
       CLOS based on PCL version:  March 92 PCL (2a)
   * (defmethod test ((x null)) nil)
   
   #<Standard-Method TEST (NULL) {700D63D}>
   * (defmethod test ((x list)) t)
   
   #<Standard-Method TEST (LIST) {70115F5}>
   * (test nil)
   Compiling LAMBDA (#:G4 #:G5): 
   Compiling Top-Level Form: 
   
   NIL
   * (test nil)
   
   T
   * (quit)
   >


The simplest patch:
(in-package :pcl)
(let ((seq (find-class 'sequence))
      (sym (find-class 'symbol)))
  (setf (class-incompatible-superclass-list seq)
	(delete sym (class-incompatible-superclass-list seq)))
  (setf (class-incompatible-superclass-list sym)
	(delete seq (class-incompatible-superclass-list sym))))


The patches to apply to the sources (if you so desire):
;in defs.lisp, in the definition of *built-in-classes*,
;change the line:
    (null       (symbol)   ()                       (symbol list sequence t)
;to:
    (null       (symbol 
		 list)     ()                       (symbol list sequence t)

;in methods.lisp, in the form that begins:
(mapc
 #'proclaim-incompatible-superclasses
;change the lines:
   (number sequence character symbol	; direct subclasses of t, but not array
    standard-object structure-object)
;to:
   (number sequence character   	; direct subclasses of t, but not array
    standard-object structure-object)   ;                         or symbol

;;; also, here is a fix for another bug (I think this bug causes no problems)
;in methods.lisp, in the definition of augment-type,
;change the line:
			    (unless (*subtypep type new-type)
;to:
			    (unless (*subtypep new-type type)


;------------------------
;if you want to look at what is happening in greater detail, use this:
(in-package :pcl)

(defvar gdn #'generate-discrimination-net)
(defun generate-discrimination-net (&rest args)
  (print (list* 'generate-discrimination-net args))
  (let ((net (apply gdn args)))
    (pprint net)(terpri)
    net))


  Richard Harris