Commit e872d52c authored by Leo Liu's avatar Leo Liu

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)
parent 2beb60dc
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> 2014-08-29 Dmitry Antipov <dmantipov@yandex.ru>
* lists.texi (Functions that Rearrange Lists): Remove * lists.texi (Functions that Rearrange Lists): Remove
......
...@@ -370,6 +370,10 @@ More specifically, a Q-pattern can take the following forms: ...@@ -370,6 +370,10 @@ More specifically, a Q-pattern can take the following forms:
@item (@var{qpattern1} . @var{qpattern2}) @item (@var{qpattern1} . @var{qpattern2})
This pattern matches any cons cell whose @code{car} matches @var{QPATTERN1} and This pattern matches any cons cell whose @code{car} matches @var{QPATTERN1} and
whose @code{cdr} matches @var{PATTERN2}. 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} @item @var{atom}
This pattern matches any atom @code{equal} to @var{atom}. This pattern matches any atom @code{equal} to @var{atom}.
@item ,@var{upattern} @item ,@var{upattern}
......
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> 2014-09-01 Eli Zaretskii <eliz@gnu.org>
* NEWS: Mention that ls-lisp uses string-collate-lessp. * NEWS: Mention that ls-lisp uses string-collate-lessp.
......
...@@ -107,6 +107,9 @@ performance improvements when pasting large amounts of text. ...@@ -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. *** C-x C-x in rectangle-mark-mode now cycles through the four corners.
*** `string-rectangle' provides on-the-fly preview of the result. *** `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 ** 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. should be used instead of font-lock-fontify-buffer when called from Elisp.
......
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> 2014-09-05 Sam Steingold <sds@gnu.org>
* textmodes/tex-mode.el (tex-print-file-extension): New user * textmodes/tex-mode.el (tex-print-file-extension): New user
......
...@@ -108,11 +108,12 @@ If a SYMBOL is used twice in the same pattern (i.e. the pattern is ...@@ -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. \"non-linear\"), then the second occurrence is turned into an `eq'uality test.
QPatterns can take the following forms: QPatterns can take the following forms:
(QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
,UPAT matches if the UPattern UPAT matches. [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
STRING matches if the object is `equal' to STRING. its 0..(n-1)th elements, respectively.
ATOM matches if the object is `eq' to ATOM. ,UPAT matches if the UPattern UPAT matches.
QPatterns for vectors are not implemented yet. STRING matches if the object is `equal' to STRING.
ATOM matches if the object is `eq' to ATOM.
PRED can take the form PRED can take the form
FUNCTION in which case it gets called with one argument. 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: ...@@ -447,6 +448,24 @@ MATCH is the pattern that needs to be matched, of the form:
(pcase--mutually-exclusive-p #'consp (cadr pat))) (pcase--mutually-exclusive-p #'consp (cadr pat)))
'(:pcase--fail . nil)))) '(: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) (defun pcase--split-equal (elem pat)
(cond (cond
;; The same match will give the same result. ;; 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 ...@@ -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")) ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN"))
((floatp qpat) (error "Floating point patterns not supported")) ((floatp qpat) (error "Floating point patterns not supported"))
((vectorp qpat) ((vectorp qpat)
;; FIXME. (let* ((len (length qpat))
(error "Vector QPatterns not implemented yet")) (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) ((consp qpat)
(let* ((syma (make-symbol "xcar")) (let* ((syma (make-symbol "xcar"))
(symd (make-symbol "xcdr")) (symd (make-symbol "xcdr"))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment