X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fstd-class.lisp;h=6b9f967dd870e48c1eb5c1d1cf819c042a331067;hb=f6a2be77637d025bfded9430f02863c28f74f77a;hp=fc0e2d986fee18d6faaf6525008fc219cf18a0a4;hpb=e8b69b1dd5564a4237b1bdc1060820c3b820cde2;p=sbcl.git

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index fc0e2d9..6b9f967 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -173,9 +173,6 @@
 (defmethod class-default-initargs ((class slot-class))
   (plist-value class 'default-initargs))
 
-(defmethod class-constructors ((class slot-class))
-  (plist-value class 'constructors))
-
 (defmethod class-slot-cells ((class std-class))
   (plist-value class 'class-slot-cells))
 
@@ -285,27 +282,27 @@
                   (nreverse collect)))))))
 
 (defun map-specializers (function)
-  (map-all-classes #'(lambda (class)
-		       (funcall function (class-eq-specializer class))
-		       (funcall function class)))
-  (maphash #'(lambda (object methods)
-	       (declare (ignore methods))
-	       (intern-eql-specializer object))
+  (map-all-classes (lambda (class)
+		     (funcall function (class-eq-specializer class))
+		     (funcall function class)))
+  (maphash (lambda (object methods)
+	     (declare (ignore methods))
+	     (intern-eql-specializer object))
 	   *eql-specializer-methods*)
-  (maphash #'(lambda (object specl)
-	       (declare (ignore object))
-	       (funcall function specl))
+  (maphash (lambda (object specl)
+	     (declare (ignore object))
+	     (funcall function specl))
 	   *eql-specializer-table*)
   nil)
 
 (defun map-all-generic-functions (function)
   (let ((all-generic-functions (make-hash-table :test 'eq)))
-    (map-specializers #'(lambda (specl)
-			  (dolist (gf (specializer-direct-generic-functions
-				       specl))
-			    (unless (gethash gf all-generic-functions)
-			      (setf (gethash gf all-generic-functions) t)
-			      (funcall function gf))))))
+    (map-specializers (lambda (specl)
+			(dolist (gf (specializer-direct-generic-functions
+				     specl))
+			  (unless (gethash gf all-generic-functions)
+			    (setf (gethash gf all-generic-functions) t)
+			    (funcall function gf))))))
   nil)
 
 (defmethod shared-initialize :after ((specl class-eq-specializer)
@@ -467,8 +464,8 @@
 					 &rest initargs
 					 &key)
   (map-dependents class
-		  #'(lambda (dependent)
-		      (apply #'update-dependent class dependent initargs))))
+		  (lambda (dependent)
+		    (apply #'update-dependent class dependent initargs))))
 
 (defmethod shared-initialize :after ((slotd standard-slot-definition)
 				     slot-names &key)
@@ -559,17 +556,17 @@
     (if direct-slots-p
 	(setf (slot-value class 'direct-slots)
 	      (setq direct-slots
-		    (mapcar #'(lambda (pl)
-				(when defstruct-p
-				  (let* ((slot-name (getf pl :name))
-					 (acc-name
-					  (format nil
-						  "~S structure class ~A"
-						  name slot-name))
-					 (accessor (intern acc-name)))
-				    (setq pl (list* :defstruct-accessor-symbol
-						    accessor pl))))
-				(make-direct-slotd class pl))
+		    (mapcar (lambda (pl)
+			      (when defstruct-p
+				(let* ((slot-name (getf pl :name))
+				       (acc-name
+					(format nil
+						"~S structure class ~A"
+						name slot-name))
+				       (accessor (intern acc-name)))
+				  (setq pl (list* :defstruct-accessor-symbol
+						  accessor pl))))
+			      (make-direct-slotd class pl))
 			    direct-slots)))
 	(setq direct-slots (slot-value class 'direct-slots)))
     (when defstruct-p
@@ -577,14 +574,14 @@
         (multiple-value-bind (defstruct-form constructor reader-names writer-names)
             (make-structure-class-defstruct-form name direct-slots include)
           (unless (structure-type-p name) (eval defstruct-form))
-          (mapc #'(lambda (dslotd reader-name writer-name)
-                    (let* ((reader (gdefinition reader-name))
-                           (writer (when (gboundp writer-name)
-                                     (gdefinition writer-name))))
-                      (setf (slot-value dslotd 'internal-reader-function)
-                              reader)
-                      (setf (slot-value dslotd 'internal-writer-function)
-                              writer)))
+          (mapc (lambda (dslotd reader-name writer-name)
+		  (let* ((reader (gdefinition reader-name))
+			 (writer (when (gboundp writer-name)
+				   (gdefinition writer-name))))
+		    (setf (slot-value dslotd 'internal-reader-function)
+			  reader)
+		    (setf (slot-value dslotd 'internal-writer-function)
+			  writer)))
                 direct-slots reader-names writer-names)
           (setf (slot-value class 'defstruct-form) defstruct-form)
           (setf (slot-value class 'defstruct-constructor) constructor))))
@@ -774,9 +771,9 @@
 		   (setf (gethash gf gf-table) t))
 		 (mapc #'collect-gfs (class-direct-superclasses class))))
 	(collect-gfs class)
-	(maphash #'(lambda (gf ignore)
-		     (declare (ignore ignore))
-		     (update-gf-dfun class gf))
+	(maphash (lambda (gf ignore)
+		   (declare (ignore ignore))
+		   (update-gf-dfun class gf))
 		 gf-table)))))
 
 (defun update-inits (class inits)
@@ -822,9 +819,9 @@
 	    (if entry
 		(push d (cdr entry))
 		(push (list name d) name-dslotds-alist))))))
-    (mapcar #'(lambda (direct)
-		(compute-effective-slot-definition class
-						   (nreverse (cdr direct))))
+    (mapcar (lambda (direct)
+	      (compute-effective-slot-definition class
+						 (nreverse (cdr direct))))
 	    name-dslotds-alist)))
 
 (defmethod compute-slots :around ((class std-class))
@@ -848,11 +845,11 @@
     eslotds))
 
 (defmethod compute-slots ((class structure-class))
-  (mapcan #'(lambda (superclass)
-	      (mapcar #'(lambda (dslotd)
-			  (compute-effective-slot-definition class
-							     (list dslotd)))
-		      (class-direct-slots superclass)))
+  (mapcan (lambda (superclass)
+	    (mapcar (lambda (dslotd)
+		      (compute-effective-slot-definition class
+							 (list dslotd)))
+		    (class-direct-slots superclass)))
 	  (reverse (slot-value class 'class-precedence-list))))
 
 (defmethod compute-slots :around ((class structure-class))
@@ -1043,7 +1040,7 @@
 	(sb-sys:without-interrupts
 	  (update-lisp-class-layout class nwrapper)
 	  (setf (slot-value class 'wrapper) nwrapper)
-	  (invalidate-wrapper owrapper ':flush nwrapper))))))
+	  (invalidate-wrapper owrapper :flush nwrapper))))))
 
 (defun flush-cache-trap (owrapper nwrapper instance)
   (declare (ignore owrapper))
@@ -1063,7 +1060,7 @@
       (sb-sys:without-interrupts
 	(update-lisp-class-layout class nwrapper)
 	(setf (slot-value class 'wrapper) nwrapper)
-	(invalidate-wrapper owrapper ':obsolete nwrapper)
+	(invalidate-wrapper owrapper :obsolete nwrapper)
 	class)))
 
 (defmethod make-instances-obsolete ((class symbol))