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

2 files changed, 12 insertions, 1 deletions

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  <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 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)