branch: externals/compat
commit f4c38110b4e9ca4215d72c2da639c53f8fdb7100
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-30: Add primitive-function-p, interpreted-function-p and closurep
---
NEWS.org | 3 +++
compat-30.el | 15 +++++++++++++++
compat-tests.el | 16 ++++++++++++++++
compat.texi | 18 ++++++++++++++++++
4 files changed, 52 insertions(+)
diff --git a/NEWS.org b/NEWS.org
index c51195b74a..58ba37abed 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -4,6 +4,9 @@
* Development
+- compat-30: New function =interpreted-function-p=.
+- compat-30: New function =primitive-function-p=.
+- compat-30: New function =closurep=.
- compat-30: Add extended function =sort= with keyword arguments.
- compat-30: New function =value<=.
- compat-30: Add extended =copy-tree= with support for copying records with
diff --git a/compat-30.el b/compat-30.el
index ed7bc8b3c6..830d0c846e 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -136,6 +136,21 @@ details."
;;;; Defined in subr.el
+(compat-defun closurep (object) ;; <compat-tests:closurep>
+ "Return t if OBJECT is a function of type closure."
+ (declare (side-effect-free error-free))
+ (eq (car-safe object) 'closure))
+
+(compat-defalias interpreted-function-p closurep) ;; <compat-tests:closurep>
+
+(compat-defun primitive-function-p (object) ;;
<compat-tests:primitive-function-p>
+ "Return t if OBJECT is a built-in primitive function.
+This excludes special forms, since they are not functions."
+ (declare (side-effect-free error-free))
+ (and (subrp object)
+ (not (or (subr-native-elisp-p object)
+ (special-form-p object)))))
+
(compat-defalias drop nthcdr) ;; <compat-tests:drop>
(compat-defun merge-ordered-lists (lists &optional error-function) ;;
<compat-tests:merge-ordered-lists>
diff --git a/compat-tests.el b/compat-tests.el
index 64e1072a10..de86214f85 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1303,6 +1303,22 @@
(ert-deftest compat-subr-native-elisp-p ()
(should-not (subr-native-elisp-p (symbol-function 'identity))))
+(ert-deftest compat-closurep ()
+ (should (interpreted-function-p (eval '(lambda (x) x) t)))
+ (should (closurep (eval '(lambda (x) x) t)))
+ (should-not (closurep '(lambda (x) x)))
+ (should-not (closurep 'identity))
+ (should-not (closurep (symbol-function 'identity)))
+ (should-not (closurep (symbol-function 'if)))
+ (should-not (closurep (symbol-function 'defun))))
+
+(ert-deftest compat-primitive-function-p ()
+ (should (primitive-function-p (symbol-function 'identity)))
+ (should-not (primitive-function-p (eval '(lambda (x) x) t)))
+ (should-not (primitive-function-p '(lambda (x) x)))
+ (should-not (primitive-function-p (symbol-function 'if)))
+ (should-not (primitive-function-p (symbol-function 'defun))))
+
(ert-deftest compat-subr-primitive-p ()
(should (subr-primitive-p (symbol-function 'identity))) ;function from
fns.c
(when (< emacs-major-version 28)
diff --git a/compat.texi b/compat.texi
index 4177b56ad0..381232c3fb 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3330,6 +3330,24 @@ older than 30.1. Note that due to upstream changes, it
might happen
that there will be the need for changes, so use these functions with
care.
+@c copied from lispref/functions.texi
+@defun closurep object
+This function returns @code{t} if @var{object} is a closure, which is
+a particular kind of function object. Currently closures are used
+for all byte-code functions and all interpreted functions.
+@end defun
+
+@c copied from lispref/functions.texi
+@defun interpreted-function-p object
+This function returns @code{t} if @var{object} is an interpreted function.
+@end defun
+
+@c based on lisp/subr.el
+@defun primitive-function-p object
+Return @code{t} if @var{object} is a built-in primitive function.
+This excludes special forms, since they are not functions.
+@end defun
+
@c copied from lispref/sequences.texi
@defun value< a b
This function returns non-@code{nil} if @var{a} comes before @var{b}
