X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fslots.lisp;h=a19070bd352cf556561c751bb2ae45275f673bad;hb=237ecea4a44f33d40440ea40c67c54e9e23358b3;hp=aa82a0e67a2acfc102ac4a0ca39f4ec3a24857cc;hpb=223ac55abed63769d0a3d5831b499d0ee9ee6462;p=sbcl.git

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index aa82a0e..a19070b 100644
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -116,14 +116,11 @@
 	(slot-missing class object slot-name 'slot-value)
 	(slot-value-using-class class object slot-definition))))
 
-(setf (gdefinition 'slot-value-normal) #'slot-value)
-
-(define-compiler-macro slot-value (object-form slot-name-form)
-  (if (and (constantp slot-name-form)
-	   (let ((slot-name (eval slot-name-form)))
-	     (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-slot-value ,object-form ,slot-name-form)
-      `(slot-value-normal ,object-form ,slot-name-form)))
+(define-compiler-macro slot-value (&whole form object slot-name)
+  (if (and (constantp slot-name)
+	   (interned-symbol-p (eval slot-name)))
+      `(accessor-slot-value ,object ,slot-name)
+      form))
 
 (defun set-slot-value (object slot-name new-value)
   (let* ((class (class-of object))
@@ -133,16 +130,11 @@
 	(setf (slot-value-using-class class object slot-definition)
 	      new-value))))
 
-(setf (gdefinition 'set-slot-value-normal) #'set-slot-value)
-
-(define-compiler-macro set-slot-value (object-form
-				       slot-name-form
-				       new-value-form)
-  (if (and (constantp slot-name-form)
-	   (let ((slot-name (eval slot-name-form)))
-	     (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-set-slot-value ,object-form ,slot-name-form ,new-value-form)
-      `(set-slot-value-normal ,object-form ,slot-name-form ,new-value-form)))
+(define-compiler-macro set-slot-value (&whole form object slot-name new-value)
+  (if (and (constantp slot-name)
+	   (interned-symbol-p (eval slot-name)))
+      `(accessor-set-slot-value ,object ,slot-name ,new-value)
+      form))
 
 (defun slot-boundp (object slot-name)
   (let* ((class (class-of object))
@@ -153,12 +145,11 @@
 
 (setf (gdefinition 'slot-boundp-normal) #'slot-boundp)
 
-(define-compiler-macro slot-boundp (object-form slot-name-form)
-  (if (and (constantp slot-name-form)
-	   (let ((slot-name (eval slot-name-form)))
-	     (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-slot-boundp ,object-form ,slot-name-form)
-      `(slot-boundp-normal ,object-form ,slot-name-form)))
+(define-compiler-macro slot-boundp (&whole form object slot-name)
+  (if (and (constantp slot-name)
+	   (interned-symbol-p (eval slot-name)))
+      `(accessor-slot-boundp ,object ,slot-name)
+      form))
 
 (defun slot-makunbound (object slot-name)
   (let* ((class (class-of object))