projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.12.8: Really this time. Note to self: remeber to save the
[sbcl.git]
/
src
/
pcl
/
slots-boot.lisp
diff --git
a/src/pcl/slots-boot.lisp
b/src/pcl/slots-boot.lisp
index
0d3b707
..
43bf09a
100644
(file)
--- a/
src/pcl/slots-boot.lisp
+++ b/
src/pcl/slots-boot.lisp
@@
-78,8
+78,12
@@
(slot-missing-fun slot-name type)
"generated slot-missing method"
slot-name)))))
(slot-missing-fun slot-name type)
"generated slot-missing method"
slot-name)))))
- (unless (fboundp fun-name)
- (let ((gf (ensure-generic-function fun-name)))
+ (unless (fboundp fun-name)
+ (let ((gf (ensure-generic-function
+ fun-name
+ :lambda-list (ecase type
+ ((reader boundp) '(object))
+ (writer '(new-value object))))))
(ecase type
(reader (add-slot-missing-method gf slot-name 'slot-value))
(boundp (add-slot-missing-method gf slot-name 'slot-boundp))
(ecase type
(reader (add-slot-missing-method gf slot-name 'slot-value))
(boundp (add-slot-missing-method gf slot-name 'slot-boundp))
@@
-465,15
+469,16
@@
initargs)))
(defun initialize-internal-slot-gfs (slot-name &optional type)
initargs)))
(defun initialize-internal-slot-gfs (slot-name &optional type)
- (macrolet ((frob (type name-fun add-fun)
+ (macrolet ((frob (type name-fun add-fun ll)
`(when (or (null type) (eq type ',type))
(let* ((name (,name-fun slot-name))
`(when (or (null type) (eq type ',type))
(let* ((name (,name-fun slot-name))
- (gf (ensure-generic-function name))
+ (gf (ensure-generic-function name
+ :lambda-list ',ll))
(methods (generic-function-methods gf)))
(when (or (null methods)
(plist-value gf 'slot-missing-method))
(setf (plist-value gf 'slot-missing-method) nil)
(,add-fun *the-class-slot-object* gf slot-name))))))
(methods (generic-function-methods gf)))
(when (or (null methods)
(plist-value gf 'slot-missing-method))
(setf (plist-value gf 'slot-missing-method) nil)
(,add-fun *the-class-slot-object* gf slot-name))))))
- (frob reader slot-reader-name add-reader-method)
- (frob writer slot-writer-name add-writer-method)
- (frob boundp slot-boundp-name add-boundp-method)))
+ (frob reader slot-reader-name add-reader-method (object))
+ (frob writer slot-writer-name add-writer-method (new-value object))
+ (frob boundp slot-boundp-name add-boundp-method (object))))