1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 14:30:43 -08:00

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

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

View file

@ -1,5 +1,9 @@
2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca> 2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/pcase.el (pcase--split-match, pcase--app-subst-match):
Handle the case where `match' is :pcase--succeed or :pcase--fail
(bug#18554).
Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el. Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el.
* emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode. * emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode.
(eldoc-schedule-timer): Obey it. (eldoc-schedule-timer): Obey it.

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) (defun pcase--split-match (sym splitter match)
(cond (cond
((eq (car match) 'match) ((eq (car-safe match) 'match)
(if (not (eq sym (cadr match))) (if (not (eq sym (cadr match)))
(cons match match) (cons match match)
(let ((res (funcall splitter (cddr match)))) (let ((res (funcall splitter (cddr match))))
(cons (or (car res) match) (or (cdr res) match))))) (cons (or (car res) match) (or (cdr res) match)))))
((memq (car match) '(or and)) ((memq (car-safe match) '(or and))
(let ((then-alts '()) (let ((then-alts '())
(else-alts '()) (else-alts '())
(neutral-elem (if (eq 'or (car match)) (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 else-alts) neutral-elem)
((null (cdr else-alts)) (car else-alts)) ((null (cdr else-alts)) (car else-alts))
(t (cons (car match) (nreverse else-alts))))))) (t (cons (car match) (nreverse else-alts)))))))
((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
(t (error "Uknown MATCH %s" match)))) (t (error "Uknown MATCH %s" match))))
(defun pcase--split-rest (sym splitter rest) (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) (defun pcase--app-subst-match (match sym fun nsym)
(cond (cond
((eq (car match) 'match) ((eq (car-safe match) 'match)
(if (and (eq sym (cadr match)) (if (and (eq sym (cadr match))
(eq 'app (car-safe (cddr match))) (eq 'app (car-safe (cddr match)))
(equal fun (nth 1 (cddr match)))) (equal fun (nth 1 (cddr match))))
(pcase--match nsym (nth 2 (cddr match))) (pcase--match nsym (nth 2 (cddr match)))
match)) match))
((memq (car match) '(or and)) ((memq (car-safe match) '(or and))
`(,(car match) `(,(car match)
,@(mapcar (lambda (match) ,@(mapcar (lambda (match)
(pcase--app-subst-match match sym fun nsym)) (pcase--app-subst-match match sym fun nsym))
(cdr match)))) (cdr match))))
((memq match '(:pcase--succeed :pcase--fail)) match)
(t (error "Uknown MATCH %s" match)))) (t (error "Uknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym) (defun pcase--app-subst-rest (rest sym fun nsym)