(pcase): New _ syntax in pred/app functions

The current syntax for functions in `app` and `pred` patterns
allows a shorthand (F ARGS) where the object being matched is
added as an extra last argument.  This is nice for things like
(pred (< 5)) but sometimes the object needs to be at
another position.
Until now you had to use (pred (lambda (x) (memq x my-list)))
or (pred (pcase--flip memq my-list)) in those cases.
So, introduce a new shorthand where `_` can be used to indicate
where the object should be passed: (pred (memq _ my-list))

* lisp/emacs-lisp/pcase.el (pcase--split-pred): Document new syntax
for pred/app functions.
(pcase--funcall): Support new syntax.
(pcase--flip): Declare obsolete.
(pcase--u1, \`): Use `_` instead.
(pcase--split-pred): Adjust accordingly.

* doc/lispref/control.texi (pcase Macro): Document new syntax
for pred/app functions.

* lisp/progmodes/opascal.el (pcase-defmacro):
* lisp/emacs-lisp/seq.el (seq--make-pcase-bindings):
* lisp/emacs-lisp/eieio.el (eieio):
* lisp/emacs-lisp/cl-macs.el (cl-struct, cl-type):
Use _ instead of `pcase--flip`.
(cl--pcase-mutually-exclusive-p): Adjust accordingly.

* lisp/emacs-lisp/map.el (map--pcase-map-elt): Declare obsolete.
(map--make-pcase-bindings): Use `_` instead.

doc/lispref/control.texi

@@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional
 Example: @code{(= 42)}@*
 In this example, the function is @code{=}, @var{n} is one, and
 the actual function call becomes: @w{@code{(= 42 @var{expval})}}.
+
+@item function call with an @code{_} arg
+Call the function (the first element of the function call)
+with the specified arguments (the other elements) and replacing
+@code{_} with @var{expval}.
+
+Example: @code{(gethash _ memo-table)}
+In this example, the function is @code{gethash}, and
+the actual function call becomes: @w{@code{(gethash @var{expval}
+memo-table)}}.
 @end table
 
 @item (app @var{function} @var{pattern})

etc/NEWS

@@ -1526,6 +1526,10 @@ values.
 
 * Lisp Changes in Emacs 30.1
 
++++
+** Pcase's functions (in 'pred' and 'app') can specify the argument position.
+For example, instead of (pred (< 5)) you can write (pred (> _ 5)).
+
 +++
 ** 'define-advice' now sets the new advice's 'name' property to NAME.
 Named advices defined with 'define-advice' can now be removed with

lisp/emacs-lisp/cl-macs.el

@@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
 contents of field NAME is matched against PAT, or they can be of
 the form NAME which is a shorthand for (NAME NAME)."
   (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp])))
-  `(and (pred (pcase--flip cl-typep ',type))
+  `(and (pred (cl-typep _ ',type))
         ,@(mapcar
            (lambda (field)
              (let* ((name (if (consp field) (car field) field))
                     (pat (if (consp field) (cadr field) field)))
                `(app ,(if (eq (cl-struct-sequence-type type) 'list)
                           `(nth ,(cl-struct-slot-offset type name))
-                        `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+                        `(aref _ ,(cl-struct-slot-offset type name)))
                      ,pat)))
            fields)))
 
@@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)."
   "Extra special cases for `cl-typep' predicates."
   (let* ((x1 pred1) (x2 pred2)
          (t1
-          (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
-               (eq 'cl-typep (car-safe x1))    (setq x1 (cdr x1))
+          (and (eq 'cl-typep (car-safe x1))    (setq x1 (cdr x1))
+               (eq '_ (car-safe x1))           (setq x1 (cdr x1))
                (null (cdr-safe x1))            (setq x1 (car x1))
                (eq 'quote (car-safe x1))       (cadr x1)))
          (t2
-          (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
-               (eq 'cl-typep (car-safe x2))    (setq x2 (cdr x2))
+          (and (eq 'cl-typep (car-safe x2))    (setq x2 (cdr x2))
+               (eq '_ (car-safe x2))           (setq x2 (cdr x2))
                (null (cdr-safe x2))            (setq x2 (car x2))
                (eq 'quote (car-safe x2))       (cadr x2))))
     (or
@@ -3818,7 +3818,8 @@ STRUCT-TYPE and SLOT-NAME are symbols.  INST is a structure instance."
 (pcase-defmacro cl-type (type)
   "Pcase pattern that matches objects of TYPE.
 TYPE is a type descriptor as accepted by `cl-typep', which see."
-  `(pred (pcase--flip cl-typep ',type)))
+  `(pred (cl-typep _ ',type)))
+
 
 ;; Local variables:
 ;; generated-autoload-file: "cl-loaddefs.el"

lisp/emacs-lisp/eieio.el

@@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of
         ,@(mapcar (lambda (field)
                     (pcase-exhaustive field
                       (`(,name ,pat)
-                       `(app (pcase--flip eieio-oref ',name) ,pat))
+                       `(app (eieio-oref _ ',name) ,pat))
                       ((pred symbolp)
-                       `(app (pcase--flip eieio-oref ',field) ,field))))
+                       `(app (eieio-oref _ ',field) ,field))))
                   fields)))
 
 ;;; Simple generators, and query functions.  None of these would do

lisp/emacs-lisp/map.el

@@ -608,18 +608,19 @@ This allows using default values for `map-elt', which can't be
 done using `pcase--flip'.
 
 KEY is the key sought in the map.  DEFAULT is the default value."
+  (declare (obsolete _ "30.1"))
   `(map-elt ,map ,key ,default))
 
 (defun map--make-pcase-bindings (args)
   "Return a list of pcase bindings from ARGS to the elements of a map."
   (mapcar (lambda (elt)
             (cond ((consp elt)
-                   `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
+                   `(app (map-elt _ ,(car elt) ,(caddr elt))
                          ,(cadr elt)))
                   ((keywordp elt)
                    (let ((var (intern (substring (symbol-name elt) 1))))
-                     `(app (pcase--flip map-elt ,elt) ,var)))
-                  (t `(app (pcase--flip map-elt ',elt) ,elt))))
+                     `(app (map-elt _ ,elt) ,var)))
+                  (t `(app (map-elt _ ',elt) ,elt))))
           args))
 
 (defun map--make-pcase-patterns (args)

lisp/emacs-lisp/pcase.el

@@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms:
      call it with one argument
   (F ARG1 .. ARGn)
      call F with ARG1..ARGn and EXPVAL as n+1'th argument
+  (F ARG1 .. _ .. ARGn)
+     call F, passing EXPVAL at the _ position.
 
 FUN, BOOLEXP, and subsequent PAT can refer to variables
 bound earlier in the pattern by a SYMBOL pattern.
@@ -814,10 +816,10 @@ A and B can be one of:
                     #'compiled-function-p))))
         (pcase--mutually-exclusive-p (cadr upat) otherpred))
       '(:pcase--fail . nil))
-     ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
+     ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c)))
      ;; try and preserve the info we get from that memq test.
-     ((and (eq 'pcase--flip (car-safe (cadr upat)))
-           (memq (cadr (cadr upat)) '(memq member memql))
+     ((and (memq (car-safe (cadr upat)) '(memq member memql))
+           (eq (cadr (cadr upat)) '_)
            (eq 'quote (car-safe (nth 2 (cadr upat))))
            (eq 'quote (car-safe pat)))
       (let ((set (cadr (nth 2 (cadr upat)))))
@@ -865,7 +867,7 @@ A and B can be one of:
 
 (defmacro pcase--flip (fun arg1 arg2)
   "Helper function, used internally to avoid (funcall (lambda ...) ...)."
-  (declare (debug (sexp body)))
+  (declare (debug (sexp body)) (obsolete _ "30.1"))
   `(,fun ,arg2 ,arg1))
 
 (defun pcase--funcall (fun arg vars)
@@ -886,9 +888,13 @@ A and B can be one of:
                      (let ((newsym (gensym "x")))
                        (push (list newsym arg) env)
                        (setq arg newsym)))
-                   (if (or (functionp fun) (not (consp fun)))
-                       `(funcall #',fun ,arg)
-                     `(,@fun ,arg)))))
+                   (cond
+                    ((or (functionp fun) (not (consp fun)))
+                     `(funcall #',fun ,arg))
+                    ((memq '_ fun)
+                     (mapcar (lambda (x) (if (eq '_ x) arg x)) fun))
+                    (t
+                     `(,@fun ,arg))))))
       (if (null env)
           call
         ;; Let's not replace `vars' in `fun' since it's
@@ -949,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of the form
        ;; Yes, we can use `memql' (or `member')!
        ((> (length simples) 1)
         (pcase--u1 (cons `(match ,var
-                                 . (pred (pcase--flip ,mem-fun ',simples)))
+                                 . (pred (,mem-fun _ ',simples)))
                          (cdr matches))
                    code vars
                    (if (null others) rest
@@ -1096,12 +1102,13 @@ The predicate is the logical-AND of:
   (declare (debug (pcase-QPAT)))
   (cond
    ((eq (car-safe qpat) '\,) (cadr qpat))
+   ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat))
    ((vectorp qpat)
     `(and (pred vectorp)
           (app length ,(length qpat))
           ,@(let ((upats nil))
               (dotimes (i (length qpat))
-                (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i)))
+                (push `(app (aref _ ,i) ,(list '\` (aref qpat i)))
                       upats))
               (nreverse upats))))
    ((consp qpat)

lisp/emacs-lisp/seq.el

@@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers."
       (unless rest-marker
         (pcase name
           (`&rest
-           (progn (push `(app (pcase--flip seq-drop ,index)
+           (progn (push `(app (seq-drop _ ,index)
                               ,(seq--elt-safe args (1+ index)))
                         bindings)
                   (setq rest-marker t)))
           (_
-           (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+           (push `(app (seq--elt-safe _ ,index) ,name) bindings))))
       (setq index (1+ index)))
     bindings))
 

lisp/progmodes/opascal.el

@@ -281,7 +281,7 @@ nested routine.")
 
 (eval-when-compile
   (pcase-defmacro opascal--in (set)
-    `(pred (pcase--flip memq ,set))))
+    `(pred (memq _ ,set))))
 
 (defun opascal-string-of (start end)
   ;; Returns the buffer string from start to end.