diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2024-03-12 09:26:24 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2024-03-18 09:29:47 -0400 |
commit | 706403f2aa3a306369a0150022da0cba1802ca2b (patch) | |
tree | c2a2a7e1dc919efdead6ee36f1fb91e3f624c673 /src | |
parent | 1a8b34a503e5af32851c1aac27a3f09e2345673b (diff) | |
download | emacs-706403f2aa3a306369a0150022da0cba1802ca2b.tar.gz |
(cl-type-of): New function to return more precise types (bug#69739)
* src/data.c (Fcl_type_of): New function, extracted from `Ftype_of`.
Make it return more precise types for symbols, integers, and subrs.
(Ftype_of): Use it.
(syms_of_data): Define the corresponding new symbols and defsubr
the new function.
* doc/lispref/objects.texi (Type Predicates): Document it.
* src/comp.c (emit_limple_insn): Use `Fcl_type_of`.
* lisp/emacs-lisp/cl-preloaded.el (subr): Demote it to `atom`.
(subr-native-elisp, subr-primitive): Add `compiled-function` as
parent instead.
(special-form): New type.
* lisp/obsolete/eieio-core.el (cl--generic-struct-tag):
* lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-generalizer):
Use `cl-type-of`.
cl--generic--unreachable-types): Update accordingly.
test/src/data-tests.el (data-tests--cl-type-of): New test.
Diffstat (limited to 'src')
-rw-r--r-- | src/comp.c | 2 | ||||
-rw-r--r-- | src/data.c | 40 |
2 files changed, 36 insertions, 6 deletions
diff --git a/src/comp.c b/src/comp.c index 3f989c722d4..76cf1f3ab6e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2442,7 +2442,7 @@ emit_limple_insn (Lisp_Object insn) { Lisp_Object arg1 = arg[1]; - if (EQ (Ftype_of (arg1), Qcomp_mvar)) + if (EQ (Fcl_type_of (arg1), Qcomp_mvar)) res = emit_mvar_rval (arg1); else if (EQ (FIRST (arg1), Qcall)) res = emit_limple_call (XCDR (arg1)); diff --git a/src/data.c b/src/data.c index 35f4c82c68f..5d6b6e0ba9d 100644 --- a/src/data.c +++ b/src/data.c @@ -193,16 +193,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0, DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, doc: /* Return a symbol representing the type of OBJECT. The symbol returned names the object's basic type; -for example, (type-of 1) returns `integer'. */) +for example, (type-of 1) returns `integer'. +Contrary to `cl-type-of', the returned type is not always the most +precise type possible, because instead this function tries to preserve +compatibility with the return value of previous Emacs versions. */) + (Lisp_Object object) +{ + return SYMBOLP (object) ? Qsymbol + : INTEGERP (object) ? Qinteger + : SUBRP (object) ? Qsubr + : Fcl_type_of (object); +} + +DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, + doc: /* Return a symbol representing the type of OBJECT. +The returned symbol names the most specific possible type of the object. +for example, (cl-type-of nil) returns `null'. +The specific type returned may change depending on Emacs versions, +so we recommend you use `cl-typep', `cl-typecase', or other predicates +rather than compare the return value of this function against +a fixed set of types. */) (Lisp_Object object) { switch (XTYPE (object)) { case_Lisp_Int: - return Qinteger; + return Qfixnum; case Lisp_Symbol: - return Qsymbol; + return NILP (object) ? Qnull + : EQ (object, Qt) ? Qboolean + : Qsymbol; case Lisp_String: return Qstring; @@ -215,7 +236,7 @@ for example, (type-of 1) returns `integer'. */) switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; - case PVEC_BIGNUM: return Qinteger; + case PVEC_BIGNUM: return Qbignum; case PVEC_MARKER: return Qmarker; case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; @@ -224,7 +245,10 @@ for example, (type-of 1) returns `integer'. */) case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; - case PVEC_SUBR: return Qsubr; + case PVEC_SUBR: + return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form + : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp + : Qsubr_primitive; case PVEC_COMPILED: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; @@ -4202,7 +4226,9 @@ syms_of_data (void) "Variable binding depth exceeds max-specpdl-size"); /* Types that type-of returns. */ + DEFSYM (Qboolean, "boolean"); DEFSYM (Qinteger, "integer"); + DEFSYM (Qbignum, "bignum"); DEFSYM (Qsymbol, "symbol"); DEFSYM (Qstring, "string"); DEFSYM (Qcons, "cons"); @@ -4218,6 +4244,9 @@ syms_of_data (void) DEFSYM (Qprocess, "process"); DEFSYM (Qwindow, "window"); DEFSYM (Qsubr, "subr"); + DEFSYM (Qspecial_form, "special-form"); + DEFSYM (Qsubr_primitive, "subr-primitive"); + DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); @@ -4255,6 +4284,7 @@ syms_of_data (void) defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); + defsubr (&Scl_type_of); defsubr (&Slistp); defsubr (&Snlistp); defsubr (&Sconsp); |