From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 18 Jun 2012 19:23:35 +0000 (-0400)
Subject: * lisp/emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
X-Git-Tag: emacs-24.2.90~1199^2~434
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ee4b13300e0b1feae48d8141026f9235e9ebe69a;p=emacs.git

* lisp/emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
(pcase--u1, pcase--q1): Don't use apply-partially.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4810238c86a..90fad4be7eb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2012-06-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
+	(pcase--u1, pcase--q1): Don't use apply-partially.
+
 2012-06-18  Glenn Morris  <rgm@gnu.org>
 
 	* progmodes/python.el (python-proc, python-buffer)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 81cffae04bf..f91a1645e21 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -237,7 +237,8 @@ of the form (UPAT EXP)."
                       ;; the branch to a separate function.
                       (let ((bsym
                              (make-symbol (format "pcase-%d" (length defs)))))
-                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs)
+                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
+                              defs)
                         (setcar res 'funcall)
                         (setcdr res (cons bsym (mapcar #'cdr prevvars)))
                         (setcar (cddr prev) bsym)
@@ -255,17 +256,26 @@ of the form (UPAT EXP)."
                       ;; FIXME: But if some of `prevvars' are not in `vars' we
                       ;; should remove them from `prevvars'!
                       `(funcall ,res ,@args)))))))
+           (used-cases ())
            (main
             (pcase--u
              (mapcar (lambda (case)
                        `((match ,val . ,(car case))
-                         ,(apply-partially
-                           (if (pcase--small-branch-p (cdr case))
-                               ;; Don't bother sharing multiple
-                               ;; occurrences of this leaf since it's small.
-                               #'pcase-codegen codegen)
-                           (cdr case))))
+                         ,(lambda (vars)
+                            (unless (memq case used-cases)
+                              ;; Keep track of the cases that are used.
+                              (push case used-cases))
+                            (funcall
+                             (if (pcase--small-branch-p (cdr case))
+                                 ;; Don't bother sharing multiple
+                                 ;; occurrences of this leaf since it's small.
+                                 #'pcase-codegen codegen)
+                             (cdr case)
+                             vars))))
                      cases))))
+      (dolist (case cases)
+        (unless (or (memq case used-cases) (eq (car case) 'dontcare))
+          (message "Redundant pcase pattern: %S" (car case))))
       (macroexp-let* defs main))))
 
 (defun pcase-codegen (code vars)
@@ -566,7 +576,7 @@ Otherwise, it defers to REST which is a list of branches of the form
         (if (eq (car upat) 'pred) (put sym 'pcase-used t))
         (let* ((splitrest
                 (pcase--split-rest
-                 sym (apply-partially #'pcase--split-pred upat) rest))
+                 sym (lambda (pat) (pcase--split-pred upat pat)) rest))
                (then-rest (car splitrest))
                (else-rest (cdr splitrest)))
           (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
@@ -636,7 +646,7 @@ Otherwise, it defers to REST which is a list of branches of the form
               (let* ((elems (mapcar 'cadr (cdr upat)))
                      (splitrest
                       (pcase--split-rest
-                       sym (apply-partially #'pcase--split-member elems) rest))
+                       sym (lambda (pat) (pcase--split-member elems pat)) rest))
                      (then-rest (car splitrest))
                      (else-rest (cdr splitrest)))
                 (put sym 'pcase-used t)
@@ -693,7 +703,7 @@ Otherwise, it defers to REST which is a list of branches of the form
            (symd (make-symbol "xcdr"))
            (splitrest (pcase--split-rest
                        sym
-                       (apply-partially #'pcase--split-consp syma symd)
+                       (lambda (pat) (pcase--split-consp syma symd pat))
                        rest))
            (then-rest (car splitrest))
            (else-rest (cdr splitrest))
@@ -716,7 +726,7 @@ Otherwise, it defers to REST which is a list of branches of the form
        (pcase--u else-rest))))
    ((or (integerp qpat) (symbolp qpat) (stringp qpat))
       (let* ((splitrest (pcase--split-rest
-                         sym (apply-partially 'pcase--split-equal qpat) rest))
+                         sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
              (then-rest (car splitrest))
              (else-rest (cdr splitrest)))
       (pcase--if (cond