mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00
Code Issues Releases Activity

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

Browse Source 
the predicate returns nil.
This commit is contained in:
Stefan Monnier 2013-01-08 17:26:21 -05:00
parent a464813702
commit 4bdc352611
2 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/ChangeLog
View File

@ -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.

29
lisp/emacs-lisp/pcase.el
View File

@ -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."