From e872d52c93433a80c4b1eb9b8179b5d30c65dcf3 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Sat, 6 Sep 2014 08:59:00 +0800 Subject: [PATCH] Add vector qpattern to pcase * doc/lispref/control.texi (Pattern matching case statement): Document vector qpattern. * etc/NEWS: Mention vector qpattern for pcase. (Bug#18327). * lisp/emacs-lisp/pcase.el (pcase): Doc fix. (pcase--split-vector): New function. (pcase--q1): Support vector qpattern. (Bug#18327) --- doc/lispref/ChangeLog | 5 ++++ doc/lispref/control.texi | 4 +++ etc/ChangeLog | 4 +++ etc/NEWS | 3 +++ lisp/ChangeLog | 6 +++++ lisp/emacs-lisp/pcase.el | 55 +++++++++++++++++++++++++++++++++++----- 6 files changed, 70 insertions(+), 7 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index a9954d84658..7b375a7a819 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2014-09-06 Leo Liu + + * control.texi (Pattern matching case statement): Document vector + qpattern. (Bug#18327) + 2014-08-29 Dmitry Antipov * lists.texi (Functions that Rearrange Lists): Remove diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index edf60dd5cc8..08d2ff35a6a 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -370,6 +370,10 @@ More specifically, a Q-pattern can take the following forms: @item (@var{qpattern1} . @var{qpattern2}) This pattern matches any cons cell whose @code{car} matches @var{QPATTERN1} and whose @code{cdr} matches @var{PATTERN2}. +@item [@var{qpattern1 qpattern2..qpatternm}] +This pattern matches a vector of length @code{M} whose 0..(M-1)th +elements match @var{QPATTERN1}, @var{QPATTERN2}..@var{QPATTERNm}, +respectively. @item @var{atom} This pattern matches any atom @code{equal} to @var{atom}. @item ,@var{upattern} diff --git a/etc/ChangeLog b/etc/ChangeLog index 8dbdb46c826..404822a79ea 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2014-09-06 Leo Liu + + * NEWS: Mention vector qpattern for pcase. (Bug#18327). + 2014-09-01 Eli Zaretskii * NEWS: Mention that ls-lisp uses string-collate-lessp. diff --git a/etc/NEWS b/etc/NEWS index 669b51ebb38..796d0935683 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -107,6 +107,9 @@ performance improvements when pasting large amounts of text. *** C-x C-x in rectangle-mark-mode now cycles through the four corners. *** `string-rectangle' provides on-the-fly preview of the result. ++++ +** Macro `pcase' now supports vector qpattern. + ** New font-lock functions font-lock-ensure and font-lock-flush, which should be used instead of font-lock-fontify-buffer when called from Elisp. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 502981d6179..c96c67fda99 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2014-09-06 Leo Liu + + * emacs-lisp/pcase.el (pcase): Doc fix. + (pcase--split-vector): New function. + (pcase--q1): Support vector qpattern. (Bug#18327) + 2014-09-05 Sam Steingold * textmodes/tex-mode.el (tex-print-file-extension): New user diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 2cdb7b4987e..963d6a44041 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -108,11 +108,12 @@ 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. - ,UPAT matches if the UPattern UPAT matches. - STRING matches if the object is `equal' to STRING. - ATOM matches if the object is `eq' to ATOM. -QPatterns for vectors are not implemented yet. + (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. + [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match + its 0..(n-1)th elements, respectively. + ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. + ATOM matches if the object is `eq' to ATOM. PRED can take the form FUNCTION in which case it gets called with one argument. @@ -447,6 +448,24 @@ MATCH is the pattern that needs to be matched, of the form: (pcase--mutually-exclusive-p #'consp (cadr pat))) '(:pcase--fail . nil)))) +(defun pcase--split-vector (syms pat) + (cond + ;; A QPattern for a vector of same length. + ((and (eq (car-safe pat) '\`) + (vectorp (cadr pat)) + (= (length syms) (length (cadr pat)))) + (let ((qpat (cadr pat))) + (cons `(and ,@(mapcar (lambda (s) + `(match ,(car s) . + ,(pcase--upat (aref qpat (cdr s))))) + syms)) + :pcase--fail))) + ;; Other QPatterns go to the `else' side. + ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) + ((and (eq (car-safe pat) 'pred) + (pcase--mutually-exclusive-p #'vectorp (cadr pat))) + '(:pcase--fail . nil)))) + (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. @@ -738,8 +757,30 @@ Otherwise, it defers to REST which is a list of branches of the form ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN")) ((floatp qpat) (error "Floating point patterns not supported")) ((vectorp qpat) - ;; FIXME. - (error "Vector QPatterns not implemented yet")) + (let* ((len (length qpat)) + (syms (mapcar (lambda (i) (cons (make-symbol (format "xaref%s" i)) i)) + (number-sequence 0 (1- len)))) + (splitrest (pcase--split-rest + sym + (lambda (pat) (pcase--split-vector syms pat)) + rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest)) + (then-body (pcase--u1 + `(,@(mapcar (lambda (s) + `(match ,(car s) . + ,(pcase--upat (aref qpat (cdr s))))) + syms) + ,@matches) + code vars then-rest))) + (pcase--if + `(and (vectorp ,sym) (= (length ,sym) ,len)) + (macroexp-let* (delq nil (mapcar (lambda (s) + (and (get (car s) 'pcase-used) + `(,(car s) (aref ,sym ,(cdr s))))) + syms)) + then-body) + (pcase--u else-rest)))) ((consp qpat) (let* ((syma (make-symbol "xcar")) (symd (make-symbol "xcdr")) -- 2.39.5