[Emacs-diffs] /srv/bzr/emacs/trunk r103327: * lisp/emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns.

[Stefan Monnier]

------------------------------------------------------------
revno: 103327
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2011-02-17 23:58:21 -0500
message:
  * lisp/emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/pcase.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-02-18 04:20:36 +0000
+++ b/lisp/ChangeLog    2011-02-18 04:58:21 +0000
@@ -1,3 +1,7 @@
+2011-02-18  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns.
+
 2011-02-18  Christian Ohler  <address@hidden>
 
        * emacs-lisp/ert.el (ert--setup-results-buffer)

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2011-01-25 04:08:28 +0000
+++ b/lisp/emacs-lisp/pcase.el  2011-02-18 04:58:21 +0000
@@ -61,6 +61,8 @@
   `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 @@
                      (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)