compat-30: Add primitive-function-p, interpreted-function-p and closurep

4 files changed, 52 insertions, 0 deletions

diff --git a/NEWS.org b/NEWS.org
index c51195b..58ba37a 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 ed7bc8b..830d0c8 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 64e1072..de86214 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 4177b56..381232c 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}