From 4bdc352611db6d7e9a11e75693e94dce61377d2e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 8 Jan 2013 17:26:21 -0500 Subject: [PATCH] * lisp/emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if the predicate returns nil. --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/pcase.el | 29 +++++++++++++++-------------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 58dec6e41ec..92c071e1776 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2013-01-08 Stefan Monnier + * 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 69834810d11..e000c343721 100644 --- 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." -- 2.39.5