From 8aa9f63ab314c44840f6f0b331c5308988521f4a Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 10 Nov 2002 18:38:38 +0000 Subject: [PATCH] 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. --- src/pcl/slots.lisp | 39 +++++++++++++++------------------------ version.lisp-expr | 2 +- 2 files changed, 16 insertions(+), 25 deletions(-) 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)) diff --git a/version.lisp-expr b/version.lisp-expr index 8bec1de..b27b312 100644 --- 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" -- 1.7.10.4