From 0038790653e05feb0d87384845edadd6dade29b8 Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Sat, 16 Jul 2016 19:40:39 +0200 Subject: [PATCH] Remove leading NIL from slot name lists A FIXME comment said: NIL at the head of the list is a remnant from old purged code, that hasn't been quite cleaned up yet. Changed producers of such lists: * SLOT-NAME-LISTS-FROM-SLOTS * MAKE-STD-{WRITER,READER,BOUNDP}-METHOD-FUNCTION Changed consumers: * INTERN-PV-TABLE * COMPUTE-PV --- src/pcl/slots-boot.lisp | 12 ++++++------ src/pcl/vector.lisp | 13 +++---------- 2 files changed, 9 insertions(+), 16 deletions(-) diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index 450fce8fb..a6d474556 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -444,7 +444,7 @@ .pv. instance-slots 0 (slot-value instance slot-name)))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list (list nil slot-name))) + (list (list slot-name))) initargs)) ((:custom :accessor) (let* ((initargs (copy-tree @@ -454,7 +454,7 @@ (instance) nil) (instance-read-custom .pv. 0 instance))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list (list nil slot-name))) + (list (list slot-name))) initargs)))) (defun make-std-writer-method-function (class-or-name slot-name) @@ -479,7 +479,7 @@ .pv. instance-slots 0 nv (setf (slot-value instance slot-name) .good-new-value.))))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list nil (list nil slot-name))) + (list nil (list slot-name))) initargs)) ((:custom :accessor) (let ((initargs (copy-tree @@ -489,7 +489,7 @@ (instance) nil) (instance-write-custom .pv. 0 instance nv))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list nil (list nil slot-name))) + (list nil (list slot-name))) initargs))))) (defun make-std-boundp-method-function (class-or-name slot-name) @@ -504,7 +504,7 @@ .pv. instance-slots 0 (slot-boundp instance slot-name)))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list (list nil slot-name))) + (list (list slot-name))) initargs)) ((:custom :accessor) (let ((initargs (copy-tree @@ -514,7 +514,7 @@ (instance) nil) (instance-boundp-custom .pv. 0 instance))))))) (setf (getf (getf initargs 'plist) :slot-name-lists) - (list (list nil slot-name))) + (list (list slot-name))) initargs)))) ;;;; FINDING SLOT DEFINITIONS diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index bf717ba92..05796a3d2 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -63,20 +63,13 @@ (defun intern-pv-table (&key slot-name-lists) (flet ((intern-slot-names (slot-names) - ;; FIXME: NIL at the head of the list is a remnant from - ;; old purged code, that hasn't been quite cleaned up yet. - ;; ...but as long as we assume it is there, we may as well - ;; assert it. - (aver (not (car slot-names))) (or (gethash slot-names *slot-name-lists*) (setf (gethash slot-names *slot-name-lists*) slot-names))) (%intern-pv-table (snl) (or (gethash snl *pv-tables*) (setf (gethash snl *pv-tables*) (make-pv-table :slot-name-lists snl - :pv-size (* 2 (reduce #'+ snl - :key (lambda (slots) - (length (cdr slots)))))))))) + :pv-size (* 2 (reduce #'+ snl :key #'length))))))) (sb-thread:with-mutex (*pv-lock*) (%intern-pv-table (mapcar #'intern-slot-names slot-name-lists))))) @@ -105,7 +98,7 @@ (let* ((wrapper (pop wrappers)) (std-p (layout-for-std-class-p wrapper)) (class (wrapper-class* wrapper))) - (dolist (slot-name (cdr slot-names)) + (dolist (slot-name slot-names) (let ((cell (or (find-slot-cell wrapper slot-name) (cons nil (slot-missing-info class slot-name))))) @@ -533,7 +526,7 @@ (defun slot-name-lists-from-slots (slots) (mapcar (lambda (parameter-entry) (when (cdr parameter-entry) - (cons nil (mapcar #'car (cdr parameter-entry))))) + (mapcar #'car (cdr parameter-entry)))) (mutate-slots slots))) (defun mutate-slots (slots) -- 2.11.4.GIT