* lisp/emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 139bd5e432ec85bbc7a378c58c4a79c81afae803..8e850fb940995a87f3107d2e2dce6257ed45afe0 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2011-02-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns.
+
 2011-02-18  Christian Ohler  <ohler@gnu.org>
 
        * emacs-lisp/ert.el (ert--setup-results-buffer)

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 24ea0a3e80154d9cff1038a5a8cc7741280a1591..3179672a3ec0aa233a31f3f0efc634956c120b91 100644 (file)
--- 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)