summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/pcase.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/pcase.el')
-rw-r--r--lisp/emacs-lisp/pcase.el14
1 files changed, 13 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 963d6a44041..94aedd4339a 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -68,6 +68,8 @@
(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
+(defvar pcase--dontwarn-upats '(pcase--dontcare))
+
(def-edebug-spec
pcase-UPAT
(&or symbolp
@@ -148,6 +150,15 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+;;;###autoload
+(defmacro pcase-exhaustive (exp &rest cases)
+ "The exhaustive version of `pcase' (which see)."
+ (declare (indent 1) (debug pcase))
+ (let* ((x (make-symbol "x"))
+ (pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
+ (pcase--expand
+ exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
+
(defun pcase--let* (bindings body)
(cond
((null bindings) (macroexp-progn body))
@@ -280,7 +291,8 @@ of the form (UPAT EXP)."
vars))))
cases))))
(dolist (case cases)
- (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+ (unless (or (memq case used-cases)
+ (memq (car case) pcase--dontwarn-upats))
(message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main))))