bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Leo Liu]

[-- 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"))

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Leo Liu]

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.

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Stefan Monnier]

> 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

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Leo Liu]

[-- 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"))

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Stefan Monnier]

>> 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

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Leo Liu]

On 2014-09-04 16:34 -0400, Stefan Monnier wrote:
> If that can be split into its own function without too much trouble,
      ^
      |
      +--- should be possible if I know what is `that'?

Thanks for the comments, BTW. - Leo

bug#18327: 24.4.50; [PATCH] vector QPattern for pcase

[Lars Ingebrigtsen]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> +  [QPAT1 QPAT2]         matches if QPAT1/2 match the first/second elements

It seems like pcase now has support for vectors, so I'm closing this bug
report.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no