From 19faa8e8535ff2c23aa122025145e2d159c0aa77 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2012 05:26:04 -0400 Subject: [PATCH] * lisp/emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns". (pcase--self-quoting-p): New function. (pcase--u1): Use it. --- lisp/ChangeLog | 18 ++++++++++++------ lisp/emacs-lisp/pcase.el | 19 ++++++++++++++----- 2 files changed, 26 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3fd8534d6a0..dbe46c66d50 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-07-10 Stefan Monnier + + * 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 * emacs-lisp/authors.el (authors-fixed-entries): @@ -31,8 +37,8 @@ 2012-07-07 Chong Yidong * 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 @@ -71,8 +77,8 @@ 2012-07-06 Andreas Schwab - * 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 @@ -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 diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 529c5ebdb67..59dccb35952 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -94,6 +94,7 @@ CASES is a list of elements of the form (UPATTERN CODE...). 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 @@ MATCH is the pattern that needs to be matched, of the form: (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 @@ Otherwise, it defers to REST which is a list of branches of the form `(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 @@ Otherwise, it defers to REST which is a list of branches of the form (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)) -- 2.39.2