diff options
Diffstat (limited to 'lisp/emacs-lisp/pcase.el')
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7859860c560..ae2cf8eb02f 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -63,6 +63,7 @@ ;; FIXME: Now that macroexpansion is also performed when loading an interpreted ;; file, this is not a real problem any more. (defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq)) +;; (defconst pcase--memoize (make-hash-table :test 'eq)) ;; (defconst pcase--memoize-1 (make-hash-table :test 'eq)) ;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal)) @@ -175,7 +176,9 @@ Emacs Lisp manual for more information and examples." ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. +;;;###autoload (put 'pcase 'function-documentation '(pcase--make-docstring)) +;;;###autoload (defun pcase--make-docstring () (let* ((main (documentation (symbol-function 'pcase) 'raw)) (ud (help-split-fundoc main 'pcase))) @@ -782,25 +785,26 @@ Otherwise, it defers to REST which is a list of branches of the form ((eq 'or (caar matches)) (let* ((alts (cdar matches)) (var (if (eq (caar alts) 'match) (cadr (car alts)))) - (simples '()) (others '()) (memq-ok t)) + (simples '()) (others '()) (mem-fun 'memq)) (when var (dolist (alt alts) (if (and (eq (car alt) 'match) (eq var (cadr alt)) (let ((upat (cddr alt))) (eq (car-safe upat) 'quote))) (let ((val (cadr (cddr alt)))) - (unless (or (integerp val) (symbolp val)) - (setq memq-ok nil)) - (push (cadr (cddr alt)) simples)) + (cond ((integerp val) + (when (eq mem-fun 'memq) + (setq mem-fun 'memql))) + ((not (symbolp val)) + (setq mem-fun 'member))) + (push val simples)) (push alt others)))) (cond ((null alts) (error "Please avoid it") (pcase--u rest)) - ;; Yes, we can use `memq' (or `member')! + ;; Yes, we can use `memql' (or `member')! ((> (length simples) 1) (pcase--u1 (cons `(match ,var - . (pred (pcase--flip - ,(if memq-ok #'memq #'member) - ',simples))) + . (pred (pcase--flip ,mem-fun ',simples))) (cdr matches)) code vars (if (null others) rest @@ -887,7 +891,8 @@ Otherwise, it defers to REST which is a list of branches of the form (else-rest (cdr splitrest))) (pcase--if (cond ((null val) `(null ,sym)) - ((or (integerp val) (symbolp val)) + ((integerp val) `(eql ,sym ,val)) + ((symbolp val) (if (pcase--self-quoting-p val) `(eq ,sym ,val) `(eq ,sym ',val))) @@ -936,7 +941,7 @@ QPAT can take the following forms: ,PAT matches if the `pcase' pattern PAT matches. SYMBOL matches if EXPVAL is `equal' to SYMBOL. KEYWORD likewise for KEYWORD. - INTEGER likewise for INTEGER. + NUMBER likewise for NUMBER. STRING likewise for STRING. The list or vector QPAT is a template. The predicate formed @@ -966,7 +971,10 @@ The predicate is the logical-AND of: `(and (pred consp) (app car ,(list '\` (car qpat))) (app cdr ,(list '\` (cdr qpat))))) - ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) + ((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat) + ;; In all other cases just raise an error so we can't break + ;; backward compatibility when adding \` support for other + ;; compounded values that are not `consp' (t (error "Unknown QPAT: %S" qpat)))) (provide 'pcase) |