X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fslots.lisp;h=69232a7ce6ddef929ffcf5aaf541f1bbcc3fc323;hb=037b95d81ad246aca72388ce7315df972e9545f5;hp=b1fcbb39da124acaacca7629dd48d2e171eb0bac;hpb=479ef26343b45753fc019b6535d3aa0ee54cb324;p=sbcl.git

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index b1fcbb3..69232a7 100644
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -75,44 +75,17 @@
 	 (t
 	  (error "unrecognized instance type")))))
 
-(defun get-class-slot-value-1 (object wrapper slot-name)
-  (let ((entry (assoc slot-name (wrapper-class-slots wrapper))))
-    (if (null entry)
-	(slot-missing (wrapper-class wrapper) object slot-name 'slot-value)
-	(if (eq (cdr entry) +slot-unbound+)
-	    (slot-unbound (wrapper-class wrapper) object slot-name)
-	    (cdr entry)))))
-
-(defun set-class-slot-value-1 (new-value object wrapper slot-name)
-  (let ((entry (assoc slot-name (wrapper-class-slots wrapper))))
-    (if (null entry)
-	(slot-missing (wrapper-class wrapper)
-		      object
-		      slot-name
-		      'setf
-		      new-value)
-	(setf (cdr entry) new-value))))
-
-(defmethod class-slot-value ((class std-class) slot-name)
-  (let ((wrapper (class-wrapper class))
-	(prototype (class-prototype class)))
-    (get-class-slot-value-1 prototype wrapper slot-name)))
-
-(defmethod (setf class-slot-value) (nv (class std-class) slot-name)
-  (let ((wrapper (class-wrapper class))
-	(prototype (class-prototype class)))
-    (set-class-slot-value-1 nv prototype wrapper slot-name)))
-
 (defun find-slot-definition (class slot-name)
   (dolist (slot (class-slots class) nil)
     (when (eql slot-name (slot-definition-name slot))
       (return slot))))
 
+(declaim (ftype (sfunction (t symbol) t) slot-value))
 (defun slot-value (object slot-name)
   (let* ((class (class-of object))
 	 (slot-definition (find-slot-definition class slot-name)))
     (if (null slot-definition)
-	(slot-missing class object slot-name 'slot-value)
+	(values (slot-missing class object slot-name 'slot-value))
 	(slot-value-using-class class object slot-definition))))
 
 (define-compiler-macro slot-value (&whole form object slot-name)
@@ -125,7 +98,8 @@
   (let* ((class (class-of object))
 	 (slot-definition (find-slot-definition class slot-name)))
     (if (null slot-definition)
-	(slot-missing class object slot-name 'setf new-value)
+	(progn (slot-missing class object slot-name 'setf new-value)
+	       new-value)
 	(setf (slot-value-using-class class object slot-definition)
 	      new-value))))
 
@@ -139,7 +113,7 @@
   (let* ((class (class-of object))
 	 (slot-definition (find-slot-definition class slot-name)))
     (if (null slot-definition)
-	(slot-missing class object slot-name 'slot-boundp)
+	(not (not (slot-missing class object slot-name 'slot-boundp)))
 	(slot-boundp-using-class class object slot-definition))))
 
 (setf (gdefinition 'slot-boundp-normal) #'slot-boundp)
@@ -155,7 +129,8 @@
 	 (slot-definition (find-slot-definition class slot-name)))
     (if (null slot-definition)
 	(slot-missing class object slot-name 'slot-makunbound)
-	(slot-makunbound-using-class class object slot-definition))))
+	(slot-makunbound-using-class class object slot-definition))
+    object))
 
 (defun slot-exists-p (object slot-name)
   (let ((class (class-of object)))
@@ -196,7 +171,7 @@
                            ~S method.~@:>"
 			  slotd 'slot-value-using-class)))))
     (if (eq value +slot-unbound+)
-	(slot-unbound class object (slot-definition-name slotd))
+	(values (slot-unbound class object (slot-definition-name slotd)))
 	value)))
 
 (defmethod (setf slot-value-using-class)
@@ -305,7 +280,7 @@
 	 (value (funcall function object)))
     (declare (type function function))
     (if (eq value +slot-unbound+)
-	(slot-unbound class object (slot-definition-name slotd))
+	(values (slot-unbound class object (slot-definition-name slotd)))
 	value)))
 
 (defmethod (setf slot-value-using-class)
@@ -346,13 +321,15 @@
   (error 'unbound-slot :name slot-name :instance instance))
 
 (defun slot-unbound-internal (instance position)
-  (slot-unbound (class-of instance) instance
-		(etypecase position
-		  (fixnum
-		   (nth position
-			(wrapper-instance-slots-layout (wrapper-of instance))))
-		  (cons
-		   (car position)))))
+  (values
+   (slot-unbound
+    (class-of instance)
+    instance
+    (etypecase position
+      (fixnum
+       (nth position (wrapper-instance-slots-layout (wrapper-of instance))))
+      (cons
+       (car position))))))
 
 (defmethod allocate-instance ((class standard-class) &rest initargs)
   (declare (ignore initargs))