[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/object-type 41184670fd4 2/3: (primitive-function): New type
From: |
Stefan Monnier |
Subject: |
scratch/object-type 41184670fd4 2/3: (primitive-function): New type |
Date: |
Sun, 17 Mar 2024 18:26:31 -0400 (EDT) |
branch: scratch/object-type
commit 41184670fd4b720350da58f6051212e5cb3ea7a7
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
(primitive-function): New type
The type hierarchy and `cl-type-of` code assumed that `subr-primitive`
only applies to functions, but since it also accepts special-forms it makes
it an unsuitable choice since it can't be a subtype of `compiled-function`.
So, use a new type `primitive-function` instead.
* lisp/subr.el (subr-primitive-p): Fix docstring (bug#69832).
(primitive-function-p): New function.
* lisp/emacs-lisp/cl-preloaded.el (primitive-function): Rename
from `subr-primitive` since `subr-primitive-p` means something else.
* src/data.c (Fcl_type_of): Return `primitive-function` instead
of `subr-primitive` for C functions.
(syms_of_data): Adjust accordingly.
* test/src/data-tests.el (data-tests--cl-type-of): Remove workaround.
---
etc/NEWS | 4 ++++
lisp/emacs-lisp/cl-preloaded.el | 2 +-
lisp/subr.el | 9 ++++++++-
src/data.c | 4 ++--
test/src/data-tests.el | 4 +---
5 files changed, 16 insertions(+), 7 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index b522fbd338b..69e61d91b0e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1652,6 +1652,10 @@ This function is like 'type-of' except that it sometimes
returns
a more precise type. For example, for nil and t it returns 'null'
and 'boolean' respectively, instead of just 'symbol'.
+** New function `primitive-function-p`.
+This is like `subr-primitive-p` except that it returns t only if the
+argument is a function rather than a special-form.
+
** Built-in types have now corresponding classes.
At the Lisp level, this means that things like (cl-find-class 'integer)
will now return a class object, and at the UI level it means that
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 3e89afea452..d11c97a3e3a 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -436,7 +436,7 @@ For this build of Emacs it's %dbit."
"Type of the core syntactic elements of the Emacs Lisp language.")
(cl--define-built-in-type subr-native-elisp (subr compiled-function)
"Type of functions that have been compiled by the native compiler.")
-(cl--define-built-in-type subr-primitive (subr compiled-function)
+(cl--define-built-in-type primitive-function (subr compiled-function)
"Type of functions hand written in C.")
(unless (cl--class-parents (cl--find-class 'cl-structure-object))
diff --git a/lisp/subr.el b/lisp/subr.el
index 38a3f6edb34..9e63e409349 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -312,11 +312,18 @@ value of last one, or nil if there are none."
cond '(empty-body unless) t)))
(defsubst subr-primitive-p (object)
- "Return t if OBJECT is a built-in primitive function."
+ "Return t if OBJECT is a built-in primitive written in C."
(declare (side-effect-free error-free))
(and (subrp object)
(not (subr-native-elisp-p object))))
+(defsubst primitive-function-p (object)
+ "Return t if OBJECT is a built-in primitive function."
+ (declare (side-effect-free error-free))
+ (and (subrp object)
+ (not (or (subr-native-elisp-p object)
+ (eq (cdr (subr-arity object)) 'unevalled)))))
+
(defsubst xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
diff --git a/src/data.c b/src/data.c
index a961dd3108c..fe631b27ccc 100644
--- a/src/data.c
+++ b/src/data.c
@@ -248,7 +248,7 @@ a fixed set of types. */)
case PVEC_SUBR:
return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
: SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
- : Qsubr_primitive;
+ : Qprimitive_function;
case PVEC_COMPILED: return Qcompiled_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
@@ -4245,7 +4245,7 @@ syms_of_data (void)
DEFSYM (Qwindow, "window");
DEFSYM (Qsubr, "subr");
DEFSYM (Qspecial_form, "special-form");
- DEFSYM (Qsubr_primitive, "subr-primitive");
+ DEFSYM (Qprimitive_function, "primitive-function");
DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 9d76c58224d..daa49e671b5 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -869,9 +869,7 @@ comparing the subr with a much slower Lisp implementation."
tree-sitter-node tree-sitter-parser
;; `functionp' also matches things of type
;; `symbol' and `cons'.
- ;; FIXME: `subr-primitive-p' also matches
- ;; special-forms.
- function subr-primitive))
+ function))
(should-not (cl-typep val subtype)))))))))