* bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
@ 2014-08-25 8:02 Leo Liu
2014-08-29 2:42 ` Leo Liu
2014-09-04 16:21 ` Stefan Monnier
0 siblings, 2 replies; 7+ messages in thread
From: Leo Liu @ 2014-08-25 8:02 UTC (permalink / raw)
To: 18327
[-- Attachment #1: Type: text/plain, Size: 438 bytes --]
Hi Stefan,
The attached patch (inspired by your byte-code-function qpattern patch)
seems to add vector QPattern to pcase. Could you review it and give me
any comments? Thanks.
I haven't wanted vector qpattern badly enough until just now having put
up with many many:
(and (pred vectorp) io
(let `(io_request ,from ,replyas ,request)
(cl-coerce io 'list)))
which is both ugly and inefficient.
Thanks,
Leo
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pcase-vector-qpat.diff --]
[-- Type: text/x-patch, Size: 2525 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-08-25 07:52:34 +0000
@@ -54,6 +54,7 @@
;;; Code:
(require 'macroexp)
+(eval-when-compile (require 'cl-lib))
;; Macro-expansion of pcase is reasonably fast, so it's not a problem
;; when byte-compiling a file, but when interpreting the code, if the pcase
@@ -447,6 +448,22 @@
(pcase--mutually-exclusive-p #'consp (cadr pat)))
'(:pcase--fail . nil))))
+(defun pcase--split-vector (len syms pat)
+ (cond
+ ;; A QPattern for a vector of same length
+ ((and (eq (car-safe pat) '\`)
+ (vectorp (cadr pat))
+ (= len (length (cadr pat))))
+ (let ((qpat (cadr pat)))
+ (cons `(and ,@(cl-loop for s in syms for i from 0
+ collect `(match ,s . ,(pcase--upat (aref qpat i)))))
+ :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 +755,27 @@
((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) (make-symbol (format "xaref%s" i)))
+ (number-sequence 0 (1- len))))
+ (splitrest (pcase--split-rest
+ sym
+ (lambda (pat) (pcase--split-vector len syms pat))
+ rest))
+ (then-rest (car splitrest))
+ (else-rest (cdr splitrest))
+ (then-body (pcase--u1
+ `(,@(cl-loop for s in syms for i from 0
+ collect `(match ,s . ,(pcase--upat (aref qpat i))))
+ ,@matches)
+ code vars then-rest)))
+ (pcase--if
+ `(and (vectorp ,sym) (= (length ,sym) ,len))
+ (macroexp-let*
+ (cl-loop for s in syms for i from 0
+ when (get s 'pcase-used) collect `(,s (aref ,sym ,i)))
+ then-body)
+ (pcase--u else-rest))))
((consp qpat)
(let* ((syma (make-symbol "xcar"))
(symd (make-symbol "xcdr"))
^ permalink raw reply [flat|nested] 7+ messages in thread* bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
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
1 sibling, 0 replies; 7+ messages in thread
From: Leo Liu @ 2014-08-29 2:42 UTC (permalink / raw)
To: 18327
On 2014-08-25 16:02 +0800, Leo Liu wrote:
> The attached patch (inspired by your byte-code-function qpattern patch)
> seems to add vector QPattern to pcase. Could you review it and give me
> any comments? Thanks.
Any comments on this patch? I have a package that is waiting to depend
on vector QPattern headily ;) Thanks, Leo.
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
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
1 sibling, 1 reply; 7+ messages in thread
From: Stefan Monnier @ 2014-09-04 16:21 UTC (permalink / raw)
To: Leo Liu; +Cc: 18327
> The attached patch (inspired by your byte-code-function qpattern patch)
> seems to add vector QPattern to pcase. Could you review it and give me
> any comments? Thanks.
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).
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?).
Stefan
^ permalink raw reply [flat|nested] 7+ messages in thread* bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
2014-09-04 16:21 ` Stefan Monnier
@ 2014-09-04 17:31 ` Leo Liu
2014-09-04 20:34 ` Stefan Monnier
0 siblings, 1 reply; 7+ messages in thread
From: Leo Liu @ 2014-09-04 17:31 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 18327
[-- 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"))
^ permalink raw reply [flat|nested] 7+ messages in thread* bug#18327: 24.4.50; [PATCH] vector QPattern for pcase
2014-09-04 17:31 ` Leo Liu
@ 2014-09-04 20:34 ` Stefan Monnier
2014-09-05 1:31 ` Leo Liu
2016-02-23 12:15 ` Lars Ingebrigtsen
0 siblings, 2 replies; 7+ messages in thread
From: Stefan Monnier @ 2014-09-04 20:34 UTC (permalink / raw)
To: Leo Liu; +Cc: 18327
>> 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.
Good, thanks.
> + [QPAT1 QPAT2] matches if QPAT1/2 match the first/second elements
This makes it sound you only handle vectors of size 2.
> +(defun pcase--split-vector (syms pat)
> + (cond
> + ;; A QPattern for a vector of same length
Please punctuate your comments.
> @@ -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))))
If that can be split into its own function without too much trouble,
then please do so.
Other than that, it looks OK, feel free to install (but do add a NEWS
entry as well).
Stefan
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2016-02-23 12:15 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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
2014-09-04 20:34 ` Stefan Monnier
2014-09-05 1:31 ` Leo Liu
2016-02-23 12:15 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).