[Emacs-diffs] /srv/bzr/emacs/trunk r111449: * lisp/emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if

[Stefan Monnier]

------------------------------------------------------------
revno: 111449
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-01-08 17:26:21 -0500
message:
  * lisp/emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if
  the predicate returns nil.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/pcase.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-01-08 20:15:15 +0000
+++ b/lisp/ChangeLog    2013-01-08 22:26:21 +0000
@@ -1,5 +1,8 @@
 2013-01-08  Stefan Monnier  <address@hidden>
 
+       * 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.

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2013-01-01 09:11:05 +0000
+++ b/lisp/emacs-lisp/pcase.el  2013-01-08 22:26:21 +0000
@@ -431,30 +431,31 @@
                   (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 @@
    ;; 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 @@
          ;; (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 @@
            (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 @@
            (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."