0.9.9.27:

	Fix most use of slot-names colliding with external symbols /
	symbols accessible from CL-USER
	... prefix most such slots by %;
	... rename METHOD-COMBINATION-TYPE to -TYPE-NAME (as in AMOP
		FIND-METHOD-COMBINATION)
	... only the TYPE slot in SPECIALIZER left to go, which is more
		complicated because in fact it's not a TYPE at all; more
		like a specifier (or maybe a typeoid)

src/pcl/boot.lisp

@@ -1779,16 +1779,16 @@ bootstrapping.
  (!bootstrap-slot-index 'standard-method 'specializers))
 (defvar *sm-fast-function-index*
  (!bootstrap-slot-index 'standard-method 'fast-function))
-(defvar *sm-function-index*
- (!bootstrap-slot-index 'standard-method 'function))
+(defvar *sm-%function-index*
+ (!bootstrap-slot-index 'standard-method '%function))
 (defvar *sm-plist-index*
  (!bootstrap-slot-index 'standard-method 'plist))
 
 ;;; FIXME: we don't actually need this; we could test for the exact
 ;;; class and deal with it as appropriate. In fact we probably don't
 ;;; need it anyway because we only use this for METHOD-SPECIALIZERS on
 ;;; the standard reader method for METHOD-SPECIALIZERS. Probably.
-(dolist (s '(specializers fast-function function plist))
+(dolist (s '(specializers fast-function %function plist))
  (aver (= (symbol-value (intern (format nil "*SM-~A-INDEX*" s)))
  (!bootstrap-slot-index 'standard-reader-method s)
  (!bootstrap-slot-index 'standard-writer-method s)
@@ -1822,7 +1822,7 @@ bootstrapping.
  *the-class-standard-boundp-method*))
  (class (class-of method)))
  (if (member class standard-method-classes)
- (clos-slots-ref (get-slots method) *sm-function-index*)
+ (clos-slots-ref (get-slots method) *sm-%function-index*)
  (method-function method))))
 (defun safe-method-qualifiers (method)
  (let ((standard-method-classes

src/pcl/braid.lisp

@@ -248,8 +248,8 @@
  name
  value)))
  (set-slot 'source nil)
- (set-slot 'type 'standard)
- (set-slot 'documentation "The standard method combination.")
+ (set-slot 'type-name 'standard)
+ (set-slot '%documentation "The standard method combination.")
  (set-slot 'options ()))
  (setq *standard-method-combination* smc))))
 
@@ -280,15 +280,15 @@
  (!bootstrap-set-slot 'class-eq-specializer spec 'object
  class)
  spec))
- (set-slot 'class-precedence-list (classes cpl))
+ (set-slot '%class-precedence-list (classes cpl))
  (set-slot 'cpl-available-p t)
  (set-slot 'can-precede-list (classes (cdr cpl)))
  (set-slot 'incompatible-superclass-list nil)
  (set-slot 'direct-superclasses (classes direct-supers))
  (set-slot 'direct-subclasses (classes direct-subclasses))
  (set-slot 'direct-methods (cons nil nil))
  (set-slot 'wrapper wrapper)
- (set-slot 'documentation nil)
+ (set-slot '%documentation nil)
  (set-slot 'plist
  `(,@(and direct-default-initargs
  `(direct-default-initargs ,direct-default-initargs))
@@ -358,9 +358,9 @@
  (set-val 'readers (get-val :readers))
  (set-val 'writers (get-val :writers))
  (set-val 'allocation :instance)
- (set-val 'type  (or (get-val :type) t))
- (set-val 'documentation (or (get-val :documentation) ""))
- (set-val 'class class)
+ (set-val '%type (or (get-val :type) t))
+ (set-val '%documentation (or (get-val :documentation) ""))
+ (set-val '%class class)
  (when effective-p
  (set-val 'location index)
  (let ((fsc-p nil))

src/pcl/defclass.lisp

@@ -436,7 +436,7 @@
  (!bootstrap-get-slot 'class class 'name))
 
 (defun early-class-precedence-list (class)
- (!bootstrap-get-slot 'pcl-class class 'class-precedence-list))
+ (!bootstrap-get-slot 'pcl-class class '%class-precedence-list))
 
 (defun early-class-name-of (instance)
  (early-class-name (class-of instance)))

src/pcl/defcombin.lisp

@@ -42,11 +42,11 @@
 ;;; FIND-METHOD-COMBINATION must appear in this file for bootstrapping
 ;;; reasons.
 (defmethod find-method-combination ((generic-function generic-function)
- (type (eql 'standard))
+ (type-name (eql 'standard))
  options)
  (when options
  (method-combination-error
- "The method combination type STANDARD accepts no options."))
+ "STANDARD method combination accepts no options."))
  *standard-method-combination*)
 
 ;;;; short method combinations
@@ -57,21 +57,21 @@
 ;;;; and runs the same rule.
 
 (defun expand-short-defcombin (whole)
- (let* ((type (cadr whole))
+ (let* ((type-name (cadr whole))
  (documentation
  (getf (cddr whole) :documentation))
  (identity-with-one-arg
  (getf (cddr whole) :identity-with-one-argument nil))
  (operator
- (getf (cddr whole) :operator type)))
+ (getf (cddr whole) :operator type-name)))
  `(load-short-defcombin
- ',type ',operator ',identity-with-one-arg ',documentation
+ ',type-name ',operator ',identity-with-one-arg ',documentation
  (sb-c:source-location))))
 
-(defun load-short-defcombin (type operator ioa doc source-location)
+(defun load-short-defcombin (type-name operator ioa doc source-location)
  (let* ((specializers
  (list (find-class 'generic-function)
- (intern-eql-specializer type)
+ (intern-eql-specializer type-name)
  *the-class-t*))
  (old-method
  (get-method #'find-method-combination () specializers nil))
@@ -80,23 +80,23 @@
  (make-instance 'standard-method
  :qualifiers ()
  :specializers specializers
- :lambda-list '(generic-function type options)
+ :lambda-list '(generic-function type-name options)
  :function (lambda (args nms &rest cm-args)
  (declare (ignore nms cm-args))
  (apply
- (lambda (gf type options)
+ (lambda (gf type-name options)
  (declare (ignore gf))
  (short-combine-methods
- type options operator ioa new-method doc))
+ type-name options operator ioa new-method doc))
  args))
  :definition-source source-location))
  (when old-method
  (remove-method #'find-method-combination old-method))
  (add-method #'find-method-combination new-method)
- (setf (random-documentation type 'method-combination) doc)
- type))
+ (setf (random-documentation type-name 'method-combination) doc)
+ type-name))
 
-(defun short-combine-methods (type options operator ioa method doc)
+(defun short-combine-methods (type-name options operator ioa method doc)
  (cond ((null options) (setq options '(:most-specific-first)))
  ((equal options '(:most-specific-first)))
  ((equal options '(:most-specific-last)))
@@ -105,9 +105,9 @@
  "Illegal options to a short method combination type.~%~
  The method combination type ~S accepts one option which~%~
  must be either :MOST-SPECIFIC-FIRST or :MOST-SPECIFIC-LAST."
- type)))
+ type-name)))
  (make-instance 'short-method-combination
- :type type
+ :type-name type-name
  :options options
  :operator operator
  :identity-with-one-argument ioa
@@ -117,7 +117,7 @@
 (defmethod compute-effective-method ((generic-function generic-function)
  (combin short-method-combination)
  applicable-methods)
- (let ((type (method-combination-type combin))
+ (let ((type-name (method-combination-type-name combin))
  (operator (short-combination-operator combin))
  (ioa (short-combination-identity-with-one-argument combin))
  (order (car (method-combination-options combin)))
@@ -132,7 +132,7 @@
  ((cdr qualifiers) (invalid generic-function combin m))
  ((eq (car qualifiers) :around)
  (push m around))
- ((eq (car qualifiers) type)
+ ((eq (car qualifiers) type-name)
  (push m primary))
  (t (invalid generic-function combin m))))))
  (setq around (nreverse around))
@@ -183,11 +183,11 @@
  (combin short-method-combination)
  method)
  (let ((qualifiers (method-qualifiers method))
- (type (method-combination-type combin)))
+ (type-name (method-combination-type-name combin)))
  (let ((why (cond
  ((null qualifiers) "has no qualifiers")
  ((cdr qualifiers) "has too many qualifiers")
- (t (aver (and (neq (car qualifiers) type)
+ (t (aver (and (neq (car qualifiers) type-name)
  (neq (car qualifiers) :around)))
  "has an invalid qualifier"))))
  (invalid-method-error
@@ -197,12 +197,12 @@
  short form of DEFINE-METHOD-COMBINATION and so requires~%~
  all methods have either the single qualifier ~S or the~%~
  single qualifier :AROUND."
- method gf why type type))))
+ method gf why type-name type-name))))
 
 ;;;; long method combinations
 
 (defun expand-long-defcombin (form)
- (let ((type (cadr form))
+ (let ((type-name (cadr form))
  (lambda-list (caddr form))
  (method-group-specifiers (cadddr form))
  (body (cddddr form))
@@ -214,55 +214,56 @@
  (setq gf-var (cadr (pop body))))
  (multiple-value-bind (documentation function)
  (make-long-method-combination-function
- type lambda-list method-group-specifiers args-option gf-var
+ type-name lambda-list method-group-specifiers args-option gf-var
  body)
- `(load-long-defcombin ',type ',documentation #',function
+ `(load-long-defcombin ',type-name ',documentation #',function
  ',args-option (sb-c:source-location)))))
 
 (defvar *long-method-combination-functions* (make-hash-table :test 'eq))
 
-(defun load-long-defcombin (type doc function args-lambda-list source-location)
+(defun load-long-defcombin 
+ (type-name doc function args-lambda-list source-location)
  (let* ((specializers
  (list (find-class 'generic-function)
- (intern-eql-specializer type)
+ (intern-eql-specializer type-name)
  *the-class-t*))
  (old-method
  (get-method #'find-method-combination () specializers nil))
  (new-method
  (make-instance 'standard-method
  :qualifiers ()
  :specializers specializers
- :lambda-list '(generic-function type options)
+ :lambda-list '(generic-function type-name options)
  :function (lambda (args nms &rest cm-args)
  (declare (ignore nms cm-args))
  (apply
- (lambda (generic-function type options)
+ (lambda (generic-function type-name options)
  (declare (ignore generic-function))
  (make-instance 'long-method-combination
- :type type
+ :type-name type-name
  :options options
  :args-lambda-list args-lambda-list
  :documentation doc))
  args))
  :definition-source source-location)))
- (setf (gethash type *long-method-combination-functions*) function)
+ (setf (gethash type-name *long-method-combination-functions*) function)
  (when old-method (remove-method #'find-method-combination old-method))
  (add-method #'find-method-combination new-method)
- (setf (random-documentation type 'method-combination) doc)
- type))
+ (setf (random-documentation type-name 'method-combination) doc)
+ type-name))
 
 (defmethod compute-effective-method ((generic-function generic-function)
  (combin long-method-combination)
  applicable-methods)
- (funcall (gethash (method-combination-type combin)
+ (funcall (gethash (method-combination-type-name combin)
  *long-method-combination-functions*)
  generic-function
  combin
  applicable-methods))
 
 (defun make-long-method-combination-function
- (type ll method-group-specifiers args-option gf-var body)
- (declare (ignore type))
+ (type-name ll method-group-specifiers args-option gf-var body)
+ (declare (ignore type-name))
  (multiple-value-bind (real-body declarations documentation)
  (parse-body body)
  (let ((wrapped-body