Re: Question on pcase

[Michael Heerdegen <michael_heerdegen@web.de>]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> But AFAIU `abo-transform-pcase-pattern' should be sufficient for your
> purpose.

Here is a version that should fit your use case better:

--8<---------------cut here---------------start------------->8---
;; -*- lexical-binding: t -*-

(defun abo-abo-pattern-matcher (pattern)
  "Turn pcase PATTERN into a predicate.
For any given pcase PATTERN, return a predicate P that returns
non-nil for any EXP when and only when PATTERN matches EXP.  In
that case, P returns a list of the form (bindings . BINDINGS) as
non-nil value, where BINDINGS is a list of bindings that pattern
matching with PATTERN would actually establish in a pcase branch."
  (let ((arg (make-symbol "exp")))
    `(lambda (,arg)
       ,(pcase--u
         `((,(pcase--match arg (pcase--macroexpand pattern))
            ,(lambda (vars)
               `(cons
                 'bindings
                 (list
                  ,@(nreverse (mapcar
                               (lambda (binding)
                                 `(cons ',(car binding)
                                        ,(cdr binding)))
                               vars)))))))))))
--8<---------------cut here---------------end--------------->8---


Example: Create a matcher predicate for the pattern

  `(,(and (pred integerp) x)
    ,(and (pred integerp)
          (pred (< 0))
           y))

and bind it to the variable `matcher':

(setq matcher
      (abo-abo-pattern-matcher
       '`(,(and (pred integerp) x)
          ,(and (pred integerp)
                (pred (< 0))
                y))))

  ==> 

--8<---------------cut here---------------start------------->8---
(lambda
  (#1=#:exp)
  (if
      (consp #1#)
      (let*
          ((#2=#:x
            (car #1#)))
        (if
            (integerp #2#)
            (let*
                ((#3=#:x
                  (cdr #1#)))
              (if
                  (consp #3#)
                  (let*
                      ((#4=#:x
                        (car #3#)))
                    (cond
                     ((not
                       (integerp #4#))
                      nil)
                     ((< 0 #4#)
                      (let*
                          ((#5=#:x
                            (cdr #3#)))
                        (if
                            (null #5#)
                            (cons 'bindings
                                  (list
                                   (cons 'x #2#)
                                   (cons 'y #4#)))
                          nil)))
                     (t nil)))
                nil))
          nil))
    nil))
--8<---------------cut here---------------end--------------->8---


(funcall matcher '(1 0))

  ==> nil

(funcall matcher '(1 2))

  ==> (bindings
       (x . 1) 
       (y . 2))


Regards,

Michael.