Merge branch 'master' into xwidget

1 files changed, 23 insertions, 7 deletions

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1bb70963a57..72ec8ec1801 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -635,7 +635,8 @@ Can only be used from within the lexical body of a primary or around method."
 
 (defun cl--generic-search-method (met-name)
   (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
-                         (regexp-quote (format "%s\\_>" (car met-name))))))
+                         (regexp-quote (format "%s" (car met-name)))
+			 "\\_>")))
     (or
      (re-search-forward
       (concat base-re "[^&\"\n]*"
@@ -724,6 +725,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 +742,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)