procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tighten up the tagcode used for eieio and cl-struct objects

Browse source 
* lisp/emacs-lisp/eieio-core.el (eieio-defclass-internal): Set the function
slot of the tag symbol to :quick-object-witness-check.
(eieio-object-p): Use :quick-object-witness-check.
(eieio--generic-tagcode): Use cl--generic-struct-tag.
* lisp/emacs-lisp/cl-preloaded.el: New file.
* lisp/emacs-lisp/cl-macs.el (cl--bind-inits): Remove, unused.
(cl--transform-lambda, cl-destructuring-bind): Remove cl--bind-inits.
(cl--make-usage-args): Strip away &aux args.
(cl-case, cl-typecase, cl--parse-loop-clause): Use macroexp-let2.
(cl-the, cl-check-type): Use macroexp-let2 and cl-typep.
(cl-defstruct): Use `declare' and cl-struct-define.
* lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): New function.
(cl--generic-struct-tagcode): Use it to tighten the tagcode.
* lisp/loadup.el: Load cl-preloaded.
* src/lisp.mk (lisp): Add cl-preloaded.
This commit is contained in:
Stefan Monnier 2015-01-27 22:41:31 -05:00
parent 7f4f16b3ae
commit 2668ac1aae
8 changed files with 201 additions and 129 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lisp/emacs-lisp/cl-generic.el
View file

@ -724,6 +724,14 @@ Can only be used from within the lexical body of a primary or around method."
(add-function :before-until cl-generic-tagcode-function
#'cl--generic-struct-tagcode)
(defun cl--generic-struct-tag (name)
`(and (vectorp ,name)
(> (length ,name) 0)
(let ((tag (aref ,name 0)))
(if (eq (symbol-function tag) :quick-object-witness-check)
tag))))
(defun cl--generic-struct-tagcode (type name)
(and (symbolp type)
(get type 'cl-struct-type)
@ -733,12 +741,19 @@ Can only be used from within the lexical body of a primary or around method."
(or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots)))
(error "Can't dispatch on cl-struct %S: no tag in slot 0"
type))
;; We could/should check the vector has length >0,
;; but really, mixing vectors and structs is a bad idea,
;; so let's not waste time trying to handle the case
;; of an empty vector.
;; BEWARE: this returns a bogus tag for non-struct vectors.
`(50 . (and (vectorp ,name) (aref ,name 0)))))
;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
;; but that would suffer from some problems:
;; - the vector may have size 0.
;; - when called on an actual vector (rather than an object), we'd
;; end up returning an arbitrary value, possibly colliding with
;; other tagcode's values.
;; - it can also result in returning all kinds of irrelevant
;; values which would end up filling up the method-cache with
;; lots of irrelevant/redundant entries.
;; FIXME: We could speed this up by introducing a dedicated
;; vector type at the C level, so we could do something like
;; (and (vector-objectp ,name) (aref ,name 0))
`(50 . ,(cl--generic-struct-tag name))))
(add-function :before-until cl-generic-tag-types-function
#'cl--generic-struct-tag-types)