0.7.9.38:

	Commit patch from Gerd Moellmann to unobfuscate some compiler
		macros (cmucl-imp 2002-09-08
		"[Patch] Compiler macros in pcl/slots.lisp"
	... frob the body of SLOT-BOUNDP, too, though can't remove the
		GDEFINITION of SLOT-BOUNDP-NORMAL as it's used
		elsewhere.

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index aa82a0e..a19070b 100644 (file)
--- 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))

diff --git a/version.lisp-expr b/version.lisp-expr
index 8bec1de..b27b312 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.37"
+"0.7.9.38"