summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2010-09-01 12:03:08 +0200
committerStefan Monnier <monnier@iro.umontreal.ca>2010-09-01 12:03:08 +0200
commit4de81ee0d223f3ffda6c22ac630ace93f0fc47f7 (patch)
treead0145f9974fb577529bde4f3efcdec5fa3f55c8 /lisp/emacs-lisp
parentda43765da1e8cadedcbb447422ced1840a2ef618 (diff)
downloademacs-4de81ee0d223f3ffda6c22ac630ace93f0fc47f7.tar.gz
emacs-4de81ee0d223f3ffda6c22ac630ace93f0fc47f7.tar.bz2
emacs-4de81ee0d223f3ffda6c22ac630ace93f0fc47f7.zip
* lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.
(pcase-u1): Handle the case of a lambda pred.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/pcase.el34
1 files changed, 20 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 0b46eb2a301..b2b27a0e0d6 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase-split-memq (elems pat)
;; Based on pcase-split-eq.
(cond
- ;; The same match will give the same result.
+ ;; The same match will give the same result, but we don't know how
+ ;; to check it.
+ ;; (???
+ ;; (cons :pcase-succeed nil))
+ ;; A match for one of the elements may succeed or fail.
((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
- (cons :pcase-succeed nil))
+ nil)
;; A different match will fail if this one succeeds.
((and (eq (car-safe pat) '\`)
;; (or (integerp (cadr pat)) (symbolp (cadr pat))
@@ -383,18 +387,20 @@ and otherwise defers to REST which is a list of branches of the form
`(,(cadr upat) ,sym)
(let* ((exp (cadr upat))
;; `vs' is an upper bound on the vars we need.
- (vs (pcase-fgrep (mapcar #'car vars) exp)))
- (if vs
- ;; Let's not replace `vars' in `exp' since it's
- ;; too difficult to do it right, instead just
- ;; let-bind `vars' around `exp'.
- `(let ,(mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs)
- ;; FIXME: `vars' can capture `sym'. E.g.
- ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
- (,@exp ,sym))
- `(,@exp ,sym))))
+ (vs (pcase-fgrep (mapcar #'car vars) exp))
+ (call (if (functionp exp)
+ `(,exp ,sym) `(,@exp ,sym))))
+ (if (null vs)
+ call
+ ;; Let's not replace `vars' in `exp' since it's
+ ;; too difficult to do it right, instead just
+ ;; let-bind `vars' around `exp'.
+ `(let ,(mapcar (lambda (var)
+ (list var (cdr (assq var vars))))
+ vs)
+ ;; FIXME: `vars' can capture `sym'. E.g.
+ ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
+ ,call))))
(pcase-u1 matches code vars then-rest)
(pcase-u else-rest))))
((symbolp upat)