New pcase construct (cheq EQPRED)

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index a6a4751f49af5c78d9693f30410f9b04ed9f0713..483aa9b8434175b80900603111d27362ccd2cb75 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -522,7 +522,7 @@ how many time this CODEGEN is called."
     (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 @@ for the result of evaluating EXP (first arg to `pcase').
    ((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 @@ recording whether the var has been referenced by earlier parts of the match."
     (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 @@ Otherwise, it defers to REST which is a list of branches of the form
         (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 @@ Otherwise, it defers to REST which is a list of branches of the form
                      (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)))))