From: Leo Liu <sdl.web@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 18327@debbugs.gnu.org
Subject: bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
Date: Fri, 05 Sep 2014 01:31:18 +0800 [thread overview]
Message-ID: <m3d2bbe1i1.fsf@gmail.com> (raw)
In-Reply-To: <jwvwq9jnyxp.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Thu, 04 Sep 2014 12:21:59 -0400")
[-- Attachment #1: Type: text/plain, Size: 740 bytes --]
On 2014-09-04 12:21 -0400, Stefan Monnier wrote:
> Please double-check that it doesn't break bootstrap (CL uses pcase as
> well, and I have some vague recollection of bumping into problems in
> this area, which is why pcase doesn't use CL).
Indeed, that failed to bootstrap. I get rid of cl-loop.
> Also the patch needs to update pcase's docstring (based on my
> understanding of your code, you only handle qpatterns of the form
> [QPAT1..QPATn], right?).
Yes, it only handles fixed-size vector qpatterns. Having built this
simpler one your byte-code qpattern patch makes a lot more sense to me.
And the `...' notation looks cool.
For the packages I am writing fixed-size qpattern is more than enough ;)
> Stefan
Thanks,
Leo
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pcase-vector-qpat2.diff --]
[-- Type: text/x-patch, Size: 3423 bytes --]
=== modified file 'lisp/emacs-lisp/pcase.el'
--- lisp/emacs-lisp/pcase.el 2014-01-03 04:40:30 +0000
+++ lisp/emacs-lisp/pcase.el 2014-09-04 17:16:34 +0000
@@ -108,11 +108,11 @@
\"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] matches if QPAT1/2 match the first/second elements
+ ,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 +447,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 +756,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"))
next prev parent reply other threads:[~2014-09-04 17:31 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-08-25 8:02 bug#18327: 24.4.50; [PATCH] vector QPattern for pcase Leo Liu
2014-08-29 2:42 ` Leo Liu
2014-09-04 16:21 ` Stefan Monnier
2014-09-04 17:31 ` Leo Liu [this message]
2014-09-04 20:34 ` Stefan Monnier
2014-09-05 1:31 ` Leo Liu
2016-02-23 12:15 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3d2bbe1i1.fsf@gmail.com \
--to=sdl.web@gmail.com \
--cc=18327@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.