[Emacs-diffs] /srv/bzr/emacs/trunk r108994: * lisp/emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".

[Stefan Monnier]

------------------------------------------------------------
revno: 108994
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-07-10 05:26:04 -0400
message:
  * lisp/emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".
  (pcase--self-quoting-p): New function.
  (pcase--u1): Use it.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/pcase.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-10 01:11:08 +0000
+++ b/lisp/ChangeLog    2012-07-10 09:26:04 +0000
@@ -1,3 +1,9 @@
+2012-07-10  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".
+       (pcase--self-quoting-p): New function.
+       (pcase--u1): Use it.
+
 2012-07-10  Glenn Morris  <address@hidden>
 
        * emacs-lisp/authors.el (authors-fixed-entries):
@@ -31,8 +37,8 @@
 2012-07-07  Chong Yidong  <address@hidden>
 
        * simple.el (yank-pop-change-selection): Doc fix (Bug#11361).
-       (interprogram-cut-function, interprogram-paste-function): Mention
-       that we typically mean the clipboard.
+       (interprogram-cut-function, interprogram-paste-function):
+       Mention that we typically mean the clipboard.
 
 2012-07-06  Glenn Morris  <address@hidden>
 
@@ -71,8 +77,8 @@
 
 2012-07-06  Andreas Schwab  <address@hidden>
 
-       * calendar/cal-dst.el (calendar-current-time-zone): Return
-       calendar-current-time-zone-cache if non-nil.
+       * calendar/cal-dst.el (calendar-current-time-zone):
+       Return calendar-current-time-zone-cache if non-nil.
 
 2012-07-06  Glenn Morris  <address@hidden>
 
@@ -85,8 +91,8 @@
        * net/tramp.el (tramp-drop-volume-letter): Provide an XEmacs
        compatible declaration.
 
-       * net/tramp-cmds.el (tramp-append-tramp-buffers): Protect
-       `list-load-path-shadows' call.
+       * net/tramp-cmds.el (tramp-append-tramp-buffers):
+       Protect `list-load-path-shadows' call.
 
        * net/tramp-compat.el (top): Require packages, which aren't
        autoloaded anymore for XEmacs.  Protect call of

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2012-06-22 13:42:38 +0000
+++ b/lisp/emacs-lisp/pcase.el  2012-07-10 09:26:04 +0000
@@ -94,6 +94,7 @@
 
 UPatterns can take the following forms:
   _            matches anything.
+  SELFQUOTING  matches itself.  This includes keywords, numbers, and strings.
   SYMBOL       matches anything and binds it to SYMBOL.
   (or UPAT...) matches if any of the patterns matches.
   (and UPAT...)        matches if all the patterns match.
@@ -509,6 +510,9 @@
     (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
     res))
 
+(defun pcase--self-quoting-p (upat)
+  (or (keywordp upat) (numberp upat) (stringp upat)))
+
 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
 ;; bootstrapping problems.
 (defun pcase--u1 (matches code vars rest)
@@ -605,6 +609,9 @@
                            `(let* ,env ,call))))
                      (pcase--u1 matches code vars then-rest)
                      (pcase--u else-rest))))
+       ((pcase--self-quoting-p upat)
+        (put sym 'pcase-used t)
+        (pcase--q1 sym upat matches code vars rest))
        ((symbolp upat)
         (put sym 'pcase-used t)
         (if (not (assq upat vars))
@@ -636,14 +643,16 @@
               (memq-fine t))
           (when all
             (dolist (alt (cdr upat))
-              (unless (and (eq (car-safe alt) '\`)
-                           (or (symbolp (cadr alt)) (integerp (cadr alt))
-                               (setq memq-fine nil)
-                               (stringp (cadr alt))))
+              (unless (or (pcase--self-quoting-p alt)
+                          (and (eq (car-safe alt) '\`)
+                               (or (symbolp (cadr alt)) (integerp (cadr alt))
+                                   (setq memq-fine nil)
+                                   (stringp (cadr alt)))))
                 (setq all nil))))
           (if all
               ;; Use memq for (or `a `b `c `d) rather than a big tree.
-              (let* ((elems (mapcar 'cadr (cdr upat)))
+              (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
+                                    (cdr upat)))
                      (splitrest
                       (pcase--split-rest
                        sym (lambda (pat) (pcase--split-member elems pat)) 
rest))