3600 improvements, and specialized describe.

[kanderso@WILMA.BBN.COM]

In 3/17 PCL:

;;; From 3600-low.lisp for M-x Kill definition
(si:define-function-spec-handler method (op spec &optional arg1 arg2)
  (if (eq op 'sys:validate-function-spec)
      (and (let ((gspec (cadr spec)))
	     (or (symbolp gspec)
		 (and (listp gspec)
		      (eq (car gspec) 'setf)
		      (symbolp (cadr gspec))
		      (null (cddr gspec)))))
	   (let ((tail (cddr spec)))
	     (loop (cond ((null tail) (return nil))
			 ((listp (car tail)) (return t))
			 ((symbolp (pop tail)))			 
			 (t (return nil))))))
      (let ((table (if (listp (cadr spec))
		       *method-setf-fdefs*
		       *method-fdefs*))
	    (key (if (listp (cadr spec))
		     (cons (cadadr spec) (cddr spec))
		     (cdr spec))))
	(case op
	  ((si:fdefinedp si:fdefinition)
	   (gethash key table nil))
	  (si:fundefine				; KRA: For M-X Kill definition
	    (multiple-value-bind (gf method nil)
		(parse-method-or-spec (cdr spec))
	      (remove-method gf method)))
	  (si:fdefine
	    (setf (gethash key table) arg1))
	  (otherwise
	    (si:function-spec-default-handler op spec arg1 arg2))))))


;;; Added to 3600-low.lisp to provide a proceed option for 
;;; ENSURE-GENERIC-FUNCTION.
(zl:defflavor generic-clobbers-function
	(name)
	(si:error)
  :initable-instance-variables)

(zl:defmethod (dbg:report generic-clobbers-function) (stream)
  (format stream "~S aready names a ~a"
	  name (if (and (symbolp name) (macro-function name)) "macro" "function")))

(zl:defmethod (sys:proceed generic-clobbers-function :specialize-it) ()
  "Make it specializable anyway?"
  (make-specializable name))

;;; From boot.lisp

(defun ensure-generic-function (spec &rest keys
				     &key lambda-list
					  argument-precedence-order
					  declarations
					  documentation
					  method-combination
					  generic-function-class
					  method-class)
  (declare (ignore lambda-list argument-precedence-order declarations
		   documentation method-combination generic-function-class method-class))
  (let ((existing (and (gboundp spec)
		       (gdefinition spec))))
    (cond ((null existing)
	   (let ((new (apply #'ensure-gf-internal spec keys)))
	     (setq new (set-function-name new spec))
	     (setf (gdefinition spec) new)))
	  ((funcallable-instance-p existing) existing)	  
	  (existing
	   #+lispm
	   (zl:signal 'generic-clobbers-function :name spec)
	   #-lispm
	   (error "~S already names an ordinary function or a macro,~%~
                   it can't be converted to a generic function."
		  spec)))))


;;; Added to high.lisp

;;; KRA: I'm not sure why this isn't done in PCL.  Should it be?
(make-specializable 'describe)

(defmethod describe ((anything object))
  (declare (ignore no-complaints))
  (describe-instance anything))