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)

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index a9954d8465837f4e8daa51755d3788525c512f5d..7b375a7a819a0de5fd6259ff52392ecf5b55fb47 100644 (file)
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
+2014-09-06  Leo Liu  <sdl.web@gmail.com>
+
+       * control.texi (Pattern matching case statement): Document vector
+       qpattern.  (Bug#18327)
+
 2014-08-29  Dmitry Antipov  <dmantipov@yandex.ru>
 
        * lists.texi (Functions that Rearrange Lists): Remove

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index edf60dd5cc8f1953aeb896cd3b8dc8f5af8b3685..08d2ff35a6a1dd07fe9095c7b86404404e932e86 100644 (file)
--- 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 8dbdb46c826e323b7ed8e6b6c79101ba2e563aa2..404822a79ea59db3bd4fd09fe69d0ca8cda4485a 100644 (file)
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
+2014-09-06  Leo Liu  <sdl.web@gmail.com>
+
+       * NEWS: Mention vector qpattern for pcase.  (Bug#18327).
+
 2014-09-01  Eli Zaretskii  <eliz@gnu.org>
 
        * NEWS: Mention that ls-lisp uses string-collate-lessp.

diff --git a/etc/NEWS b/etc/NEWS
index 669b51ebb3872bf29c700ddc375f7cdec50507b8..796d093568373baa6e52cd96a7735602ad3c8a2a 100644 (file)
--- 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 502981d61791ca7171733aedef6489f7d5fc9d75..c96c67fda99376b29aabd0a005bd368bcb22f126 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2014-09-06  Leo Liu  <sdl.web@gmail.com>
+
+       * emacs-lisp/pcase.el (pcase): Doc fix.
+       (pcase--split-vector): New function.
+       (pcase--q1): Support vector qpattern.  (Bug#18327)
+
 2014-09-05  Sam Steingold  <sds@gnu.org>
 
        * 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 2cdb7b4987e14642fb469f8605eb19c4308780b8..963d6a440414971b13b757e63ab2798799d21ef9 100644 (file)
--- 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"))