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

From: Stefan Monnier <[email-masked]>
Date: Thu, 04 Sep 2014 16:34:58 -0400

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