diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-04-04 15:06:47 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-04-04 15:06:47 -0400 |
| commit | 1f4f6b956bee611ffa406b3851e5264ee74e3bfb (patch) | |
| tree | 4d24cdef860e41b611c400492ef4a85b9a1b156a /lisp/emacs-lisp/oclosure.el | |
| parent | 6c4a4cc94e9fea809b518da9fe9e581a6031a6df (diff) | |
| download | emacs-1f4f6b956bee611ffa406b3851e5264ee74e3bfb.tar.gz emacs-1f4f6b956bee611ffa406b3851e5264ee74e3bfb.tar.bz2 emacs-1f4f6b956bee611ffa406b3851e5264ee74e3bfb.zip | |
OClosure: add support for `slot-value`
* lisp/emacs-lisp/oclosure.el (oclosure--slot-index)
(oclosure--slot-value, oclosure--set-slot-value): New functions.
* lisp/emacs-lisp/eieio-core.el (eieio-oset, eieio-oref):
Consolidate the type test. Use `oclosure--(set-)slot-value`.
(eieio--validate-slot-value, eieio--validate-class-slot-value):
Don't presume `class` is an EIEIO class.
(eieio--class): Fix bogus `:type` info.
(eieio--object-class): Simplify.
(eieio--known-slot-name-p): New function.
(eieio-oref, eieio-oref-default, eieio-oset-default): Use it.
* test/lisp/emacs-lisp/oclosure-tests.el: Require `eieio`.
(oclosure-test): Make `name` field mutable.
(oclosure-test-slot-value): New test.
Diffstat (limited to 'lisp/emacs-lisp/oclosure.el')
| -rw-r--r-- | lisp/emacs-lisp/oclosure.el | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index c37a5352a3a..3df64ad2806 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -511,6 +511,26 @@ This has 2 uses: "OClosure function to access a specific slot of an OClosure function." index) +(defun oclosure--slot-index (oclosure slotname) + (gethash slotname + (oclosure--class-index-table + (cl--find-class (oclosure-type oclosure))))) + +(defun oclosure--slot-value (oclosure slotname) + (let ((class (cl--find-class (oclosure-type oclosure))) + (index (oclosure--slot-index oclosure slotname))) + (oclosure--get oclosure index + (oclosure--slot-mutable-p + (nth index (oclosure--class-slots class)))))) + +(defun oclosure--set-slot-value (oclosure slotname value) + (let ((class (cl--find-class (oclosure-type oclosure))) + (index (oclosure--slot-index oclosure slotname))) + (unless (oclosure--slot-mutable-p + (nth index (oclosure--class-slots class))) + (signal 'setting-constant (list oclosure slotname))) + (oclosure--set value oclosure index))) + (defconst oclosure--mut-getter-prototype (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (oclosure) (oclosure--get oclosure index t))) |