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.
(cherry picked from commit
806759dc0a6a3b049ce35d0497011464e5fc4dcb)
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})
preferable to use the existing 'undo-inhibit-region' symbol property
instead of this variable.
++++
+** 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
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)))
"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
(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"
,@(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)))
\f
;;; Simple generators, and query functions. None of these would do
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)
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.
#'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)))))
(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)
(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
;; 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
(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)
(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))
(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.
projects / emacs.git / commitdiff