From 16761d7771ebbb4e3833cb1a3e3a2b75d05c6f85 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 25 Oct 2024 22:26:06 -0400 Subject: [PATCH] cond*: Add support for Pcase patterns * lisp/emacs-lisp/cond-star.el (cond*): Adjust docstring. (match*): Prefer `_VAR` syntax. (cond*-convert-condition): Add support for `pcase*`. * doc/lispref/control.texi (cond* Macro): Document `pcase*`. * test/lisp/emacs-lisp/cond-star-tests.el: New file. (cherry picked from commit d44b94a63d2d407fca5d5ec41fcb92d7b765972e) --- doc/lispref/control.texi | 11 ++++- etc/NEWS | 14 ++++--- lisp/emacs-lisp/cond-star.el | 55 ++++++++++++++++++------- test/lisp/emacs-lisp/cond-star-tests.el | 53 ++++++++++++++++++++++++ 4 files changed, 109 insertions(+), 24 deletions(-) create mode 100644 test/lisp/emacs-lisp/cond-star-tests.el diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index b996a372e28..6ad8a779d17 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1452,12 +1452,15 @@ of the clause. As a condition, it counts as true if the first binding's value is non-@code{nil}. @findex match* +@findex pcase* @code{(match* @var{pattern} @var{datum})} means to match @var{datum} against the specified @var{pattern}. The condition counts as true if @var{pattern} matches @var{datum}. The pattern can specify variables to bind to the parts of @var{datum} that they match. +@code{(pcase* @var{pattern} @var{datum})} works in the same way except it +uses the Pcase syntax for @var{pattern}. -Both @code{bind*} and @code{match*} normally bind their bindings over +@code{bind*}, @code{match*}, and @code{pcase*} normally bind their bindings over the execution of the whole containing clause. However, if the clause is written to specify ``non-exit'', the clause's bindings cover the whole rest of the @code{cond*}. @@ -1475,6 +1478,10 @@ next clause (if any). The bindings made in @var{condition} for the @var{body} of the non-exit clause are passed along to the rest of the clauses in this @code{cond*} construct. +Note: @code{pcase*} does not support @code{:non-exit}, and when used in +a non-exit clause, it follows the semantics of @code{pcase-let}, see +@ref{Destructuring with pcase Patterns}. + @subheading Matching clauses A matching clause looks like @code{(match* @var{pattern} @var{datum})}. @@ -1482,7 +1489,7 @@ It evaluates the expression @var{datum} and matches the pattern @var{pattern} (which is not evaluated) against it. @var{pattern} allows these kinds of patterns, and those that are lists -often include other patters within them: +often include other patterns within them: @table @code @item _ diff --git a/etc/NEWS b/etc/NEWS index d40d083fa40..b16d415aad1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -667,12 +667,14 @@ text "covered" by the overlay. +++ ** New macro 'cond*'. -The new macro 'cond*' is an alternative to 'pcase'. Like 'pcase', it -can be used to define several clauses, each one with its own condition; -the first clause that matches will cause its body to be evaluated. -'cond*' uses syntax that is different from that of 'pcase', which some -users might find less cryptic. See the Info node "(elisp) cond* Macro" -for details. +The new macro 'cond*' is an alternative to 'cond' and 'pcase'. +Like them, it can be used to define several clauses, each one with its +own condition; the first clause that matches will cause its body to be +evaluated. +'cond*' can use Pcase's pattern matching syntax and also provides +another pattern matching syntax that is different from that of 'pcase', +which some users might find less cryptic. +See the Info node "(elisp) cond* Macro" for details. --- ** New function 'shell-command-do-open'. diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index b4e990fcdd2..c7f2c8e17e3 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -31,10 +31,10 @@ ;; and, or, if, progn, let, let*, setq. ;; For regexp matching only, it can call string-match and match-string. -;;; ??? If a clause starts with a keyword, -;;; should the element after the keyword be treated in the usual way -;;; as a pattern? Currently `cond*-non-exit-clause-substance' explicitly -;;; prevents that by adding t at the front of its value. +;; ??? If a clause starts with a keyword, +;; should the element after the keyword be treated in the usual way +;; as a pattern? Currently `cond*-non-exit-clause-substance' explicitly +;; prevents that by adding t at the front of its value. ;;; Code: @@ -44,15 +44,20 @@ A `cond*' construct is a series of clauses, and a clause normally has the form (CONDITION BODY...). CONDITION can be a Lisp expression, as in `cond'. -Or it can be `(bind* BINDINGS...)' or `(match* PATTERN DATUM)'. +Or it can be one of `(pcase* PATTERN DATUM)', +`(bind* BINDINGS...)', or `(match* PATTERN DATUM)', + +`(pcase* PATTERN DATUM)' means to match DATUM against the +pattern PATTERN, using the same pattern syntax as `pcase'. +The condition counts as true if PATTERN matches DATUM. `(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*') for the body of the clause. As a condition, it counts as true if the first binding's value is non-nil. All the bindings are made unconditionally for whatever scope they cover. -`(match* PATTERN DATUM)' means to match DATUM against the pattern PATTERN -The condition counts as true if PATTERN matches DATUM. +`(match* PATTERN DATUM)' is an alternative to `pcase*' that uses another +syntax for its patterns, see `match*'. See `match*' for documentation of the patterns for use in such clauses. @@ -70,7 +75,7 @@ The bindings made in CONDITION for the BODY of the non-exit clause are passed along to the rest of the clauses in this `cond*' construct." (cond*-convert clauses)) -(defmacro match* (pattern datum) +(defmacro match* (pattern _datum) "This specifies matching DATUM against PATTERN. It is not really a Lisp function, and it is meaningful only in the CONDITION of a `cond*' clause. @@ -133,7 +138,7 @@ ATOM (meaning any other kind of non-list not described above) \(constrain SYMBOL EXP) matches datum if the form EXP is true. EXP can refer to symbols bound earlier in the pattern." - (ignore datum) + ;; FIXME: `byte-compile-warn-x' is not necessarily defined here. (byte-compile-warn-x pattern "`match*' used other than as a `cond*' condition")) (defun cond*-non-exit-clause-p (clause) @@ -245,8 +250,8 @@ This is used for conditional exit clauses." ;; Then always go on to run the UNCONDIT-CLAUSES. (if true-exps `(let ((,init-gensym ,first-value)) -;;; ??? Should we make the bindings a second time for the UNCONDIT-CLAUSES. -;;; as the doc string says, for uniformity with match*? +;;; ??? Should we make the bindings a second time for the UNCONDIT-CLAUSES. +;;; as the doc string says, for uniformity with match*? (let* ,mod-bindings (when ,init-gensym . ,true-exps) @@ -262,6 +267,24 @@ This is used for conditional exit clauses." (let* ,mod-bindings (when ,init-gensym . ,true-exps))))))) + ((eq pat-type 'pcase*) + (if true-exps + (progn + (when uncondit-clauses + ;; FIXME: This happens in cases like + ;; (cond* ((match* `(,x . ,y) EXP) THEN :non-exit) + ;; (t ELSE)) + ;; where ELSE is supposed to run after THEN also (and + ;; with access to `x' and `y'). + (error ":non-exit not supported with `pcase*'")) + (cl-assert (or (null iffalse) rest)) + `(pcase ,(nth 2 condition) + (,(nth 1 condition) ,@true-exps) + (_ ,iffalse))) + (cl-assert (null iffalse)) + (cl-assert (null rest)) + `(pcase-let ((,(nth 1 condition) ,(nth 2 condition))) + (cond* . ,uncondit-clauses)))) ((eq pat-type 'match*) (cond*-match condition true-exps uncondit-clauses iffalse)) (t @@ -369,11 +392,11 @@ as in `cond*-condition'." ;; because they are all gensyms anyway. (if (cdr backtrack-aliases) (setq expression - `(let ,(mapcar 'cdr (cdr backtrack-aliases)) + `(let ,(mapcar #'cdr (cdr backtrack-aliases)) ,expression))) (if retrieve-value-swap-outs (setq expression - `(let ,(mapcar 'cadr retrieve-value-swap-outs) + `(let ,(mapcar #'cadr retrieve-value-swap-outs) ,expression))) ;; If we used a gensym, wrap on code to bind it. (if gensym @@ -397,8 +420,8 @@ This is used for the bindings specified explicitly in match* patterns." (defvar cond*-debug-pattern nil) -;;; ??? Structure type patterns not implemented yet. -;;; ??? Probably should optimize the `nth' calls in handling `list'. +;; ??? Structure type patterns not implemented yet. +;; ??? Probably should optimize the `nth' calls in handling `list'. (defun cond*-subpat (subpat cdr-ignore bindings inside-or backtrack-aliases data) "Generate code to match the subpattern within `match*'. @@ -486,7 +509,7 @@ whether SUBPAT (as well as the subpatterns that contain/precede it) matches," (unless (symbolp elt) (byte-compile-warn-x vars "Non-symbol %s given as name for matched substring" elt))) ;; Bind these variables to nil, before the pattern. - (setq bindings (nconc (mapcar 'list vars) bindings)) + (setq bindings (nconc (mapcar #'list vars) bindings)) ;; Make the expressions to set the variables. (setq setqs (mapcar (lambda (var) diff --git a/test/lisp/emacs-lisp/cond-star-tests.el b/test/lisp/emacs-lisp/cond-star-tests.el new file mode 100644 index 00000000000..7cf0a99f8db --- /dev/null +++ b/test/lisp/emacs-lisp/cond-star-tests.el @@ -0,0 +1,53 @@ +;;; cond-star-tests.el --- tests for emacs-lisp/cond-star.el -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'cond-star) +(require 'ert) + +(ert-deftest cond-star-test-1 () + (should (equal (cond* + ((pcase* `(,x . ,y) (cons 5 4)) (list x y)) + (t 6)) + '(5 4))) + (should (equal (cond* + ((pcase* `(,x . ,y) nil) (list x y)) + (t 6)) + 6)) + ;; FIXME: Not supported. + ;; (let* ((z nil) + ;; (res (cond* + ;; ((pcase* `(,x . ,y) (cons 5 4)) (setq z 6) :non-exit) + ;; (t `(,x ,y ,z))))) + ;; (should (equal res '(5 4 6)))) + (should (equal (cond* + ((pcase* `(,x . ,y) (cons 5 4))) + (t (list x y))) + '(5 4))) + (should (equal (cond* + ((pcase* `(,x . ,y) nil)) + (t (list x y))) + '(nil nil))) + ) + + +;;; cond-star-tests.el ends here -- 2.39.5