masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-16 17:00:06 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/pcase.el (pcase--split-match, pcase--app-subst-match):

Browse source 
Handle the case where `match' is :pcase--succeed or :pcase--fail.

Fixes: debbugs:18554
This commit is contained in:
Stefan Monnier 2014-09-27 00:24:06 -04:00
parent e6cfa098ae
commit 528872c5f8
2 changed files with 10 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -435,12 +435,12 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-match (sym splitter match)
(cond
((eq (car match) 'match)
((eq (car-safe match) 'match)
(if (not (eq sym (cadr match)))
(cons match match)
(let ((res (funcall splitter (cddr match))))
(cons (or (car res) match) (or (cdr res) match)))))
((memq (car match) '(or and))
((memq (car-safe match) '(or and))
(let ((then-alts '())
(else-alts '())
(neutral-elem (if (eq 'or (car match))
@ -460,6 +460,7 @@ MATCH is the pattern that needs to be matched, of the form:
((null else-alts) neutral-elem)
((null (cdr else-alts)) (car else-alts))
(t (cons (car match) (nreverse else-alts)))))))
((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
(t (error "Uknown MATCH %s" match))))
(defun pcase--split-rest (sym splitter rest)
@ -570,17 +571,18 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--app-subst-match (match sym fun nsym)
(cond
((eq (car match) 'match)
((eq (car-safe match) 'match)
(if (and (eq sym (cadr match))
(eq 'app (car-safe (cddr match)))
(equal fun (nth 1 (cddr match))))
(pcase--match nsym (nth 2 (cddr match)))
match))
((memq (car match) '(or and))
((memq (car-safe match) '(or and))
`(,(car match)
,@(mapcar (lambda (match)
(pcase--app-subst-match match sym fun nsym))
(cdr match))))
((memq match '(:pcase--succeed :pcase--fail)) match)
(t (error "Uknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym)