mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

When creating the reader/writer methods, ECL did not pass the :slot-definition argument, but rather set the slot directly

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-12-03 00:06:27 +01:00
parent 19add8e833
commit aeb5563ea5
1 changed files with 23 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

39
src/clos/std-accessors.lsp
View file

@ -134,22 +134,23 @@
(std-class-optimized-accessors name))
(t
(std-class-accessors name)))
(let* ((reader-args (list :function reader
:generic-function nil
:qualifiers nil
:lambda-list '(object)
:specializers `(,standard-class)
:slot-definition slotd))
(let* ((options (list :slot-definition slotd))
(reader-args (list* :function reader
:generic-function nil
:qualifiers nil
:lambda-list '(object)
:specializers `(,standard-class)
options))
(reader-class (if (boundp '*early-methods*)
'standard-reader-method
(apply #'reader-method-class standard-class slotd
reader-args)))
(writer-args (list :function writer
:generic-function nil
:qualifiers nil
:lambda-list '(value object)
:specializers `(,(find-class t) ,standard-class)
:slot-definition slotd))
(writer-args (list* :function writer
:generic-function nil
:qualifiers nil
:lambda-list '(value object)
:specializers `(,(find-class t) ,standard-class)
options))
(writer-class (if (boundp '*early-methods*)
'standard-writer-method
(apply #'writer-method-class standard-class slotd
@ -157,16 +158,22 @@
(dolist (fname readers)
(let ((method (make-method reader-class nil `(,standard-class) '(self)
(wrapped-method-function reader)
nil)))
options)))
(safe-add-method fname method)
(setf (slot-value method 'slot-definition) slotd)))
;; This is redundant, but we need it at boot time because
;; the early MAKE-METHOD does not use the options field.
(unless *clos-booted*
(setf (slot-value method 'slot-definition) slotd))))
(dolist (fname writers)
(let ((method (make-method writer-class nil
`(,(find-class t) ,standard-class) '(value self)
(wrapped-method-function writer)
nil)))
options)))
(safe-add-method fname method)
(setf (slot-value method 'slot-definition) slotd))))))))
;; This is redundant, but we need it at boot time because
;; the early MAKE-METHOD does not use the options field.
(unless *clos-booted*
(setf (slot-value method 'slot-definition) slotd)))))))))
(defun reader-closure (index)
(declare (si::c-local))