[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r117827: Add vector qpattern to pcase
From: |
Leo Liu |
Subject: |
[Emacs-diffs] trunk r117827: Add vector qpattern to pcase |
Date: |
Sat, 06 Sep 2014 01:00:54 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 117827
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/18327
committer: Leo Liu <address@hidden>
branch nick: trunk
timestamp: Sat 2014-09-06 08:59:00 +0800
message:
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)
modified:
doc/lispref/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-6155
doc/lispref/control.texi
control.texi-20091113204419-o5vbwnq5f7feedwu-6169
etc/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1485
etc/NEWS news-20100311060928-aoit31wvzf25yr1z-1
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/emacs-lisp/pcase.el pcase.el-20100810123717-8zwve3391p2ywm1h-1
=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog 2014-08-29 11:02:56 +0000
+++ b/doc/lispref/ChangeLog 2014-09-06 00:59:00 +0000
@@ -1,3 +1,8 @@
+2014-09-06 Leo Liu <address@hidden>
+
+ * control.texi (Pattern matching case statement): Document vector
+ qpattern. (Bug#18327)
+
2014-08-29 Dmitry Antipov <address@hidden>
* lists.texi (Functions that Rearrange Lists): Remove
=== modified file 'doc/lispref/control.texi'
--- a/doc/lispref/control.texi 2014-01-24 04:11:48 +0000
+++ b/doc/lispref/control.texi 2014-09-06 00:59:00 +0000
@@ -370,6 +370,10 @@
@item (@var{qpattern1} . @var{qpattern2})
This pattern matches any cons cell whose @code{car} matches @var{QPATTERN1} and
whose @code{cdr} matches @var{PATTERN2}.
address@hidden address@hidden qpattern2..qpatternm}]
+This pattern matches a vector of length @code{M} whose 0..(M-1)th
+elements match @var{QPATTERN1}, @address@hidden,
+respectively.
@item @var{atom}
This pattern matches any atom @code{equal} to @var{atom}.
@item ,@var{upattern}
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog 2014-09-01 14:57:21 +0000
+++ b/etc/ChangeLog 2014-09-06 00:59:00 +0000
@@ -1,3 +1,7 @@
+2014-09-06 Leo Liu <address@hidden>
+
+ * NEWS: Mention vector qpattern for pcase. (Bug#18327).
+
2014-09-01 Eli Zaretskii <address@hidden>
* NEWS: Mention that ls-lisp uses string-collate-lessp.
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2014-09-05 19:07:52 +0000
+++ b/etc/NEWS 2014-09-06 00:59:00 +0000
@@ -107,6 +107,9 @@
*** 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.
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2014-09-05 19:07:52 +0000
+++ b/lisp/ChangeLog 2014-09-06 00:59:00 +0000
@@ -1,3 +1,9 @@
+2014-09-06 Leo Liu <address@hidden>
+
+ * emacs-lisp/pcase.el (pcase): Doc fix.
+ (pcase--split-vector): New function.
+ (pcase--q1): Support vector qpattern. (Bug#18327)
+
2014-09-05 Sam Steingold <address@hidden>
* textmodes/tex-mode.el (tex-print-file-extension): New user
=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el 2014-01-03 04:40:30 +0000
+++ b/lisp/emacs-lisp/pcase.el 2014-09-06 00:59:00 +0000
@@ -108,11 +108,12 @@
\"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 @@
(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 @@
((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"))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r117827: Add vector qpattern to pcase,
Leo Liu <=