Commit 85b3d352 authored by Leo Liu's avatar Leo Liu

* emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): Add

pcase-exhaustive.

* emacs-lisp/pcase.el (pcase--dontwarn-upats): New var.
(pcase--expand): Use it.
(pcase-exhaustive): New macro.

Fixes: debbugs:16567
parent 4d837e51
2014-09-13 Leo Liu <sdl.web@gmail.com>
* emacs-lisp/pcase.el (pcase--dontwarn-upats): New var.
(pcase--expand): Use it.
(pcase-exhaustive): New macro. (Bug#16567)
* emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): Add
pcase-exhaustive.
2014-09-13 Eli Zaretskii <eliz@gnu.org> 2014-09-13 Eli Zaretskii <eliz@gnu.org>
* mail/rmailmm.el (rmail-mime-insert-html): Decode the HTML part * mail/rmailmm.el (rmail-mime-insert-html): Decode the HTML part
......
...@@ -197,9 +197,9 @@ It has `lisp-mode-abbrev-table' as its parent." ...@@ -197,9 +197,9 @@ It has `lisp-mode-abbrev-table' as its parent."
(el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
"defface")) "defface"))
(el-tdefs '("defgroup" "deftheme")) (el-tdefs '("defgroup" "deftheme"))
(el-kw '("while-no-input" "letrec" "pcase" "pcase-let" (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
"pcase-let*" "save-restriction" "save-excursion" "pcase-let" "pcase-let*" "save-restriction"
"save-selected-window" "save-excursion" "save-selected-window"
;; "eval-after-load" "eval-next-after-load" ;; "eval-after-load" "eval-next-after-load"
"save-window-excursion" "save-current-buffer" "save-window-excursion" "save-current-buffer"
"save-match-data" "combine-after-change-calls" "save-match-data" "combine-after-change-calls"
......
...@@ -68,6 +68,8 @@ ...@@ -68,6 +68,8 @@
(defconst pcase--dontcare-upats '(t _ pcase--dontcare)) (defconst pcase--dontcare-upats '(t _ pcase--dontcare))
(defvar pcase--dontwarn-upats '(pcase--dontcare))
(def-edebug-spec (def-edebug-spec
pcase-UPAT pcase-UPAT
(&or symbolp (&or symbolp
...@@ -148,6 +150,15 @@ like `(,a . ,(pred (< a))) or, with more checks: ...@@ -148,6 +150,15 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion)))) 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) (defun pcase--let* (bindings body)
(cond (cond
((null bindings) (macroexp-progn body)) ((null bindings) (macroexp-progn body))
...@@ -280,7 +291,8 @@ of the form (UPAT EXP)." ...@@ -280,7 +291,8 @@ of the form (UPAT EXP)."
vars)))) vars))))
cases)))) cases))))
(dolist (case 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)))) (message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main)))) (macroexp-let* defs main))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment