mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):

Browse source 
Beware signals raised by predicates.

Fixes: debbugs:16201
This commit is contained in:
Stefan Monnier 2014-01-02 23:40:30 -05:00
parent ba05e912ae
commit 6f5475834a
2 changed files with 23 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

26
lisp/emacs-lisp/pcase.el
View file

@ -461,9 +461,10 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free))
(if (funcall (cadr pat) elem)
'(:pcase--succeed . nil)
'(:pcase--fail . nil)))))
(ignore-errors
(if (funcall (cadr pat) elem)
'(:pcase--succeed . nil)
'(:pcase--fail . nil))))))
(defun pcase--split-member (elems pat)
;; Based on pcase--split-equal.
@ -484,10 +485,11 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free)
(let ((p (cadr pat)) (all t))
(dolist (elem elems)
(unless (funcall p elem) (setq all nil)))
all))
(ignore-errors
(let ((p (cadr pat)) (all t))
(dolist (elem elems)
(unless (funcall p elem) (setq all nil)))
all)))
'(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat)
@ -761,14 +763,14 @@ Otherwise, it defers to REST which is a list of branches of the form
;; `then-body', but only within some sub-branch).
(macroexp-let*
`(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
then-body)
(pcase--u else-rest))))
((or (integerp qpat) (symbolp qpat) (stringp qpat))
(let* ((splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(let* ((splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(pcase--if (cond
((stringp qpat) `(equal ,sym ,qpat))
((null qpat) `(null ,sym))