Permalink
Browse files

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.
  • Loading branch information...
csrhodes committed Nov 10, 2002
1 parent 342b4bc commit 8aa9f63ab314c44840f6f0b331c5308988521f4a
Showing with 16 additions and 25 deletions.
  1. +15 −24 src/pcl/slots.lisp
  2. +1 −1 version.lisp-expr
View
@@ -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))
View
@@ -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"

0 comments on commit 8aa9f63

Please sign in to comment.