diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 139bd5e432e..8e850fb9409 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-02-18 Stefan Monnier + + * emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns. + 2011-02-18 Christian Ohler * emacs-lisp/ert.el (ert--setup-results-buffer) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 24ea0a3e801..3179672a3ec 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -61,6 +61,8 @@ UPatterns can take the following forms: `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. +If a SYMBOL is used twice in the same pattern (i.e. the pattern is +\"non-linear\"), then the second occurrence is turned into an `eq'uality test. QPatterns can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. @@ -457,7 +459,12 @@ and otherwise defers to REST which is a list of branches of the form (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) ((symbolp upat) - (pcase--u1 matches code (cons (cons upat sym) vars) rest)) + (if (not (assq upat vars)) + (pcase--u1 matches code (cons (cons upat sym) vars) rest) + ;; Non-linear pattern. Turn it into an `eq' test. + (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) + matches) + code vars rest))) ((eq (car-safe upat) '\`) (pcase--q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or)