* lisp/emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if

the predicate returns nil.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 58dec6e41ecd82cc2104704c8c47f83e80248fca..92c071e177678e48d08735fed8e4e3c901d35892 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2013-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if
+       the predicate returns nil.
+
        * simple.el: Use lexical-binding.
        (primitive-undo): Use pcase.
        (minibuffer-history-isearch-push-state): Use a closure.

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 69834810d1168c250a293adf9ce2d03892a117ae..e000c343721e51c0c4aced2b830c7d464dea11bb 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -431,30 +431,31 @@ MATCH is the pattern that needs to be matched, of the form:
                   (match ,symd . ,(pcase--upat (cdr qpat))))
             :pcase--fail)))
    ;; A QPattern but not for a cons, can only go to the `else' side.
-   ((eq (car-safe pat) '\`) (cons :pcase--fail nil))
+   ((eq (car-safe pat) '\`) '(:pcase--fail . nil))
    ((and (eq (car-safe pat) 'pred)
          (or (member (cons 'consp (cadr pat))
                      pcase-mutually-exclusive-predicates)
              (member (cons (cadr pat) 'consp)
                      pcase-mutually-exclusive-predicates)))
-    (cons :pcase--fail nil))))
+    '(:pcase--fail . nil))))
 
 (defun pcase--split-equal (elem pat)
   (cond
    ;; The same match will give the same result.
    ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem))
-    (cons :pcase--succeed :pcase--fail))
+    '(:pcase--succeed . :pcase--fail))
    ;; A different match will fail if this one succeeds.
    ((and (eq (car-safe pat) '\`)
          ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
          ;;     (consp (cadr pat)))
          )
-    (cons :pcase--fail nil))
+    '(:pcase--fail . nil))
    ((and (eq (car-safe pat) 'pred)
          (symbolp (cadr pat))
-         (get (cadr pat) 'side-effect-free)
-         (funcall (cadr pat) elem))
-    (cons :pcase--succeed nil))))
+         (get (cadr pat) 'side-effect-free))
+    (if (funcall (cadr pat) elem)
+        '(:pcase--succeed . nil)
+      '(:pcase--fail . nil)))))
 
 (defun pcase--split-member (elems pat)
   ;; Based on pcase--split-equal.
@@ -462,7 +463,7 @@ MATCH is the pattern that needs to be matched, of the form:
    ;; The same match (or a match of membership in a superset) will
    ;; give the same result, but we don't know how to check it.
    ;; (???
-   ;;  (cons :pcase--succeed nil))
+   ;;  '(:pcase--succeed . nil))
    ;; A match for one of the elements may succeed or fail.
    ((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
     nil)
@@ -471,7 +472,7 @@ MATCH is the pattern that needs to be matched, of the form:
          ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
          ;;     (consp (cadr pat)))
          )
-    (cons :pcase--fail nil))
+    '(:pcase--fail . nil))
    ((and (eq (car-safe pat) 'pred)
          (symbolp (cadr pat))
          (get (cadr pat) 'side-effect-free)
@@ -479,21 +480,21 @@ MATCH is the pattern that needs to be matched, of the form:
            (dolist (elem elems)
              (unless (funcall p elem) (setq all nil)))
            all))
-    (cons :pcase--succeed nil))))
+    '(:pcase--succeed . nil))))
 
 (defun pcase--split-pred (upat pat)
   ;; FIXME: For predicates like (pred (> a)), two such predicates may
   ;; actually refer to different variables `a'.
   (let (test)
     (cond
-     ((equal upat pat) (cons :pcase--succeed :pcase--fail))
+     ((equal upat pat) '(:pcase--succeed . :pcase--fail))
      ((and (eq 'pred (car upat))
            (eq 'pred (car-safe pat))
            (or (member (cons (cadr upat) (cadr pat))
                        pcase-mutually-exclusive-predicates)
                (member (cons (cadr pat) (cadr upat))
                        pcase-mutually-exclusive-predicates)))
-      (cons :pcase--fail nil))
+      '(:pcase--fail . nil))
      ((and (eq 'pred (car upat))
            (eq '\` (car-safe pat))
            (symbolp (cadr upat))
@@ -502,8 +503,8 @@ MATCH is the pattern that needs to be matched, of the form:
            (ignore-errors
              (setq test (list (funcall (cadr upat) (cadr pat))))))
       (if (car test)
-          (cons nil :pcase--fail)
-        (cons :pcase--fail nil))))))
+          '(nil . :pcase--fail)
+        '(:pcase--fail . nil))))))
 
 (defun pcase--fgrep (vars sexp)
   "Check which of the symbols VARS appear in SEXP."