GNU bug report logs - #75594
31.0.50; [FR]: Change equality test for Pcase non-linear patterns

Previous Next

Full log

View this message in rfc822 format

From: Eshel Yaron <me <at> eshelyaron.com>
To: 75594 <at> debbugs.gnu.org
Cc: michael_heerdegen <at> web.de, monnier <at> iro.umontreal.ca
Subject: bug#75594: 31.0.50; [FR]: Change equality test for Pcase non-linear patterns
Date: Wed, 15 Jan 2025 23:26:19 +0100

Eshel Yaron writes:

> What do you think about (1) switching to equal, or (2) allowing pcase
> callers to specify the equality predicate?
>
> I can imagine (1) having compatibility implications and (2) having
> performance implications, but I don't have a good sense for how
> significant these would be.

On second thought, it should be doable without affecting existing code.
The patch below adds a pattern (cheq EQ) that succeeds while changing
the equality predicate to EQ for subsequent patterns on the same branch.

With it, we get:

--8<---------------cut here---------------start------------->8---
(pcase '((foo) (foo))
  ((and (cheq equal) `(,bar ,bar ,bar)) 'a)
  (`(,bar ,bar)                         'b)
  ((and (cheq equal) `(,bar ,bar))      'c))
=> c
--8<---------------cut here---------------end--------------->8---

So I can just wrap my pattern in (and (cheq equal) ...) to use equal for
non-linear patterns.

WDYT?


diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index a6a4751f49a..483aa9b8434 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -522,7 +522,7 @@ pcase--macroexpand
     (cond
      ((null head)
       (if (pcase--self-quoting-p pat) `',pat pat))
-     ((memq head '(pred guard quote)) pat)
+     ((memq head '(pred guard quote cheq)) pat)
      ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
      ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
      (t
@@ -591,6 +591,8 @@ pcase--if
    ((eq then :pcase--dontcare) `(progn (ignore ,test) ,else))
    (t (macroexp-if test then else))))
 
+(defvar pcase--equal #'eql)
+
 ;; Note about MATCH:
 ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp'
 ;; check, we want to turn all the similar patterns into ones of the form
@@ -625,7 +627,8 @@ pcase--u
     (let* ((carbranch (car branches))
            (match (car carbranch)) (cdarbranch (cdr carbranch))
            (code (car cdarbranch))
-           (vars (cdr cdarbranch)))
+           (vars (cdr cdarbranch))
+           (pcase--equal #'eql))
       (pcase--u1 (list match) code vars (cdr branches)))))
 
 (defun pcase--and (match matches)
@@ -1053,9 +1056,9 @@ pcase--u1
         (let ((v (assq upat vars)))
           (if (not v)
               (pcase--u1 matches code (cons (list upat sym) vars) rest)
-            ;; Non-linear pattern.  Turn it into an `eq' test.
+            ;; Non-linear pattern.  Turn it into an equality test.
             (setcdr (cdr v) 'used)
-            (pcase--u1 (cons `(match ,sym . (pred (eql ,(cadr v))))
+            (pcase--u1 (cons `(match ,sym . (pred (,pcase--equal ,(cadr v))))
                              matches)
                        code vars rest))))
        ((eq (car-safe upat) 'app)
@@ -1112,6 +1115,9 @@ pcase--u1
                      (pcase--u rest))
                    vars
                    (list `((and . ,matches) ,code . ,vars))))
+       ((eq (car-safe upat) 'cheq)
+        (let ((pcase--equal (cadr upat)))
+          (pcase--u1 matches code vars rest)))
        (t (error "Unknown pattern `%S'" upat)))))
    (t (error "Incorrect MATCH %S" (car matches)))))
 

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.