Re: [PATCH] pcase.el: Add type pattern

[Adam Porter <adam@alphapapa.net>]

[-- Attachment #1: Type: text/plain, Size: 552 bytes --]

Adam Porter <adam@alphapapa.net> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>> Thanks for working on this.  I'll let others comment on whether this
>> should be added, but if it is, it should be documented in the ELisp
>> manual, like all the other patterns supported by pcase.
>
> Thanks, I'll prepare another patch that updates the manual and pcase's
> docstring.

This patch also updates the Elisp manual and the pcase docstring
accordingly.  It does not yet take into account Stefan's feedback, as
I'm awaiting further instructions.

Thanks.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Add pcase type pattern (also updates docs) --]
[-- Type: text/x-diff, Size: 3377 bytes --]

From 51a96e7f53c92d1d9d893054b73b0a0c2577dfbf Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Mon, 9 Mar 2020 13:01:32 -0500
Subject: [PATCH] * lisp/emacs-lisp/pcase.el: Add type pattern

* lisp/emacs-lisp/pcase.el:
((pcase-defmacro type)): Add 'type' pattern.
(pcase): Update docstring.

* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-type): Add test.

* doc/lispref/control.texi (pcase Macro): Update manual.
---
 doc/lispref/control.texi            | 7 +++++++
 etc/NEWS                            | 7 +++++++
 lisp/emacs-lisp/pcase.el            | 9 +++++++++
 test/lisp/emacs-lisp/pcase-tests.el | 7 +++++++
 4 files changed, 30 insertions(+)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index c601e3a..848d6a3 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -555,6 +555,13 @@ pcase Macro
 Likewise, it makes no sense to bind keyword symbols
 (@pxref{Constant Variables}).
 
+@item (type @var{type})
+Matches if @var{expval} is of type @var{type}.  The comparison is done
+with a function named @var{typep} or @var{type-p}, whichever is
+defined.
+
+Example: @code{(type integer)}
+
 @item (pred @var{function})
 Matches if the predicate @var{function} returns non-@code{nil}
 when called on @var{expval}.
diff --git a/etc/NEWS b/etc/NEWS
index 47b87af..9190bf1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -174,6 +174,13 @@ key             binding
 / v             package-menu-filter-by-version
 / /             package-menu-filter-clear
 
+** pcase.el
+
+*** Added Pcase 'type' pattern.
+
+A pattern like '(type integer)' is equivalent to one like
+'(pred integerp)'.
+
 \f
 * New Modes and Packages in Emacs 28.1
 
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 36b93fa..628e961 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -128,6 +128,7 @@ pcase
                    If a SYMBOL is used twice in the same pattern
                    the second occurrence becomes an `eq'uality test.
   (pred FUN)       matches if FUN called on EXPVAL returns non-nil.
+  (type TYPE)      matches if EXPVAL is of TYPE.
   (app FUN PAT)    matches if FUN called on EXPVAL matches PAT.
   (guard BOOLEXP)  matches if BOOLEXP evaluates to non-nil.
   (let PAT EXPR)   matches if EXPR matches PAT.
@@ -977,5 +978,13 @@ \`
    ;; compounded values that are not `consp'
    (t (error "Unknown QPAT: %S" qpat))))
 
+(pcase-defmacro type (type)
+  "Pcase pattern that matches objects of TYPE."
+  (let* ((type (symbol-name type))
+         (pred (or (intern-soft (concat type "p"))
+                   (intern-soft (concat type "-p"))
+                   (error "Unknown type: %s" type))))
+    `(pred ,pred)))
+
 (provide 'pcase)
 ;;; pcase.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 0b69bd9..5db8605 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -71,6 +71,13 @@ pcase-tests-member
 (ert-deftest pcase-tests-vectors ()
   (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
 
+(ert-deftest pcase-tests-type ()
+  (should (equal (pcase 1
+                   ((type integer) 'integer))
+                 'integer))
+  (should-error (pcase 1
+                  ((type notatype) 'integer))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
-- 
2.7.4