[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/object-type 77351fa6dee 2/2: Add object-type and preserve behavi
|
From: |
Stefan Monnier |
|
Subject: |
scratch/object-type 77351fa6dee 2/2: Add object-type and preserve behavior of type-of |
|
Date: |
Wed, 13 Mar 2024 19:16:26 -0400 (EDT) |
branch: scratch/object-type
commit 77351fa6dee7155f781193f7204ca33e783e6d98
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Add object-type and preserve behavior of type-of
---
doc/lispref/objects.texi | 32 ++++++++++++++++++++++++++------
etc/NEWS | 10 +++++-----
lisp/emacs-lisp/cl-generic.el | 5 ++---
lisp/emacs-lisp/cl-preloaded.el | 2 --
lisp/emacs-lisp/eieio-core.el | 2 +-
lisp/emacs-lisp/seq.el | 3 +--
lisp/subr.el | 17 +++++++++++++++++
src/comp.c | 2 +-
src/data.c | 18 ++++++++++++------
src/emacs-module.c | 7 ++++++-
src/lisp.h | 6 ++----
src/puresize.h | 2 +-
src/sqlite.c | 17 ++++++-----------
test/lisp/emacs-lisp/ert-tests.el | 8 ++++----
14 files changed, 84 insertions(+), 47 deletions(-)
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 00581814825..093a1718937 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2175,7 +2175,7 @@ with references to further information.
function @code{type-of}. Recall that each object belongs to one and
only one primitive type; @code{type-of} tells you which one (@pxref{Lisp
Data Types}). But @code{type-of} knows nothing about non-primitive
-types. In most cases, it is more convenient to use type predicates than
+types. In most cases, it is preferable to use type predicates than
@code{type-of}.
@defun type-of object
@@ -2186,9 +2186,8 @@ This function returns a symbol naming the primitive type
of
@code{float}, @code{font-entity}, @code{font-object},
@code{font-spec}, @code{frame}, @code{hash-table}, @code{integer},
@code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process},
-@code{string}, @code{subr-primitive}, @code{subr-native-elisp},
-@code{special-form}, @code{symbol}, @code{null}, @code{boolean},
-@code{thread}, @code{vector}, @code{window}, or @code{window-configuration}.
+@code{string}, @code{subr}, @code{symbol}, @code{thread},
+@code{vector}, @code{window}, or @code{window-configuration}.
However, if @var{object} is a record, the type specified by its first
slot is returned; @ref{Records}.
@@ -2197,9 +2196,9 @@ slot is returned; @ref{Records}.
@result{} integer
@group
(type-of 'nil)
- @result{} null
+ @result{} symbol
(type-of '()) ; @r{@code{()} is @code{nil}.}
- @result{} null
+ @result{} symbol
(type-of '(x))
@result{} cons
(type-of (record 'foo))
@@ -2208,6 +2207,27 @@ slot is returned; @ref{Records}.
@end example
@end defun
+@defun object-type object
+This function returns a symbol naming @emph{the} type of
+@var{object}. It usually behaves like @code{type-of}, except
+that it guarantees to return the most precise type possible, which means
+that the specific type it returns may change depending on the
+Emacs version. For this reason, as a rule you should never compare its
+return value against some fixed set of types.
+
+@example
+(object-type 1)
+ @result{} fixnum
+@group
+(object-type 'nil)
+ @result{} null
+(object-type (record 'foo))
+ @result{} foo
+@end group
+@end example
+@end defun
+
+
@node Equality Predicates
@section Equality Predicates
@cindex equality
diff --git a/etc/NEWS b/etc/NEWS
index d06b3f9c06d..9c4c050ae15 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -62,11 +62,6 @@ more details.
* Incompatible Changes in Emacs 30.1
-** 'type-of' sometimes returns more precise types.
-More specifically, for nil and t it returns 'null' and 'boolean'
-instead of just 'symbol' and for "subrs", it now returns one of
-'special-form', 'subr-primitive', or 'subr-native-elisp'.
-
** Tree-Sitter modes are now declared as submodes of the non-TS modes.
In order to help the use of those Tree-Sitter modes, they are now
declared to have the corresponding non-Tree-Sitter mode as an
@@ -1627,6 +1622,11 @@ values.
* Lisp Changes in Emacs 30.1
+** New function 'object-type'.
+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'.
+
** 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-generic.el b/lisp/emacs-lisp/cl-generic.el
index b79ef126ed1..22a5f47ace4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1334,8 +1334,7 @@ These match if the argument is `eql' to VAL."
(defconst cl--generic--unreachable-types
;; FIXME: Try to make that list empty?
- '(fixnum bignum boolean keyword
- special-form subr-primitive subr-native-elisp)
+ '(keyword)
"Built-in classes on which we cannot dispatch for technical reasons.")
(defun cl--generic-type-specializers (tag &rest _)
@@ -1345,7 +1344,7 @@ These match if the argument is `eql' to VAL."
(cl--class-allparents class)))))
(cl-generic-define-generalizer cl--generic-typeof-generalizer
- 10 (lambda (name &rest _) `(type-of ,name))
+ 10 (lambda (name &rest _) `(object-type ,name))
#'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 5cf4ba422df..0e8704a93c1 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -339,8 +339,6 @@
',parents))))))
;; FIXME: Our type DAG has various quirks:
-;; - `subr' says it's a `compiled-function' but that's not true
-;; for those subrs that are special forms!
;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
;; in the DAG.
;; - An OClosure can be an interpreted function or a `byte-code-function',
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 8221625d885..2a16f129de9 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1046,7 +1046,7 @@ method invocation orders of the involved classes."
(defun cl--generic-struct-tag (name &rest _)
;; Use exactly the same code as for `typeof'.
- `(type-of ,name))
+ `(object-type ,name))
(cl-generic-define-generalizer eieio--generic-generalizer
;; Use the exact same tagcode as for cl-struct, so that methods
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index cd6f26abdb3..a20cff16982 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -362,8 +362,7 @@ the result.
The result is a sequence of the same type as SEQUENCE."
(seq-concatenate
- (let ((type (type-of sequence)))
- (if (memq type '(null cons)) 'list type))
+ (if (listp sequence) 'list (type-of sequence))
(seq-subseq sequence 0 n)
(seq-subseq sequence (1+ n))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 38a3f6edb34..c329750f9dc 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -575,6 +575,23 @@ treatment of negative COUNT provided by this function."
(ash value count))
+(defun type-of (object)
+ "Return a symbol representing the type of OBJECT.
+The symbol returned names the object's basic type;
+for example, (type-of 1) returns `integer'.
+Contrary to `object-type' 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."
+ (let ((type (object-type object)))
+ (or (cdr (assq type '((bignum . integer)
+ (fixnum . integer)
+ (special-form . subr)
+ (subr-primitive . subr)
+ (subr-native-elisp . subr)
+ (null . symbol)
+ (boolean . symbol))))
+ type)))
+
;;;; List functions.
;; Note: `internal--compiler-macro-cXXr' was copied from
diff --git a/src/comp.c b/src/comp.c
index 3f989c722d4..ed9a62ce857 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 (Fobject_type (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 35bd3b19e45..a035a7112c6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -190,16 +190,20 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0,
return Qnil;
}
-DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
+DEFUN ("object-type", Fobject_type, Sobject_type, 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'. */)
+The symbol returned names the most specific possible type of the object.
+for example, (object-type 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 NILP (object) ? Qnull
@@ -217,7 +221,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;
@@ -4209,6 +4213,7 @@ syms_of_data (void)
/* Types that type-of returns. */
DEFSYM (Qboolean, "boolean");
DEFSYM (Qinteger, "integer");
+ DEFSYM (Qbignum, "bignum");
DEFSYM (Qsymbol, "symbol");
DEFSYM (Qstring, "string");
DEFSYM (Qcons, "cons");
@@ -4223,6 +4228,7 @@ syms_of_data (void)
DEFSYM (Qwindow_configuration, "window-configuration");
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");
@@ -4262,7 +4268,7 @@ syms_of_data (void)
defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
- defsubr (&Stype_of);
+ defsubr (&Sobject_type);
defsubr (&Slistp);
defsubr (&Snlistp);
defsubr (&Sconsp);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 08db39b0b0d..91f2315540a 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -702,7 +702,12 @@ module_type_of (emacs_env *env, emacs_value arg)
emacs_value tem;
MODULE_FUNCTION_BEGIN (NULL);
- tem = lisp_to_value (env, Ftype_of (value_to_lisp (arg)));
+ Lisp_Object lisp = value_to_lisp (arg);
+ Lisp_Object type = SYMBOLP (lisp) ? Qsymbol
+ : INTEGERP (lisp) ? Qinteger
+ : SUBRP (lisp) ? Qsubr
+ : Fobject_type (lisp);
+ tem = lisp_to_value (env, type);
MODULE_INTERNAL_CLEANUP ();
return tem;
}
diff --git a/src/lisp.h b/src/lisp.h
index f353e4956eb..cdd5f1bf647 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -569,10 +569,8 @@ enum Lisp_Fwd_Type
your object -- this way, the same object could be used to represent
several disparate C structures.
- In addition, you need to add switch branches in data.c for Ftype_of.
-
- You also need to add the new type to the constant
- `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */
+ In addition, you need to add switch branches in data.c for Fobject_type
+ and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */
/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a
diff --git a/src/puresize.h b/src/puresize.h
index ac5d2da30dc..2a716872832 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
diff --git a/src/sqlite.c b/src/sqlite.c
index 7a018b28aa4..261080da673 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -349,9 +349,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
value = XCAR (values);
values = XCDR (values);
}
- Lisp_Object type = Ftype_of (value);
-
- if (EQ (type, Qstring))
+ if (STRINGP (value))
{
Lisp_Object encoded;
bool blob = false;
@@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
SSDATA (encoded), SBYTES (encoded),
NULL);
}
- else if (EQ (type, Qinteger))
- {
- if (BIGNUMP (value))
- ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
- else
- ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
- }
- else if (EQ (type, Qfloat))
+ else if (FIXNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
+ else if (BIGNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
+ else if (FLOATP (value))
ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
else if (NILP (value))
ret = sqlite3_bind_null (stmt, i + 1);
diff --git a/test/lisp/emacs-lisp/ert-tests.el
b/test/lisp/emacs-lisp/ert-tests.el
index 289069362b3..1aff73d66f6 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -674,7 +674,7 @@ This macro is used to test if macroexpansion in `should'
works."
(ert-deftest ert-test-explain-equal ()
(should (equal (ert--explain-equal nil 'foo)
- '(different-types nil foo)))
+ '(different-atoms nil foo)))
(should (equal (ert--explain-equal '(a a) '(a b))
'(list-elt 1 (different-atoms a b))))
(should (equal (ert--explain-equal '(1 48) '(1 49))
@@ -732,10 +732,10 @@ This macro is used to test if macroexpansion in `should'
works."
nil))
(should (equal (ert--plist-difference-explanation
'(a b c t) '(a b))
- '(different-properties-for-key c (different-types t nil))))
+ '(different-properties-for-key c (different-atoms t nil))))
(should (equal (ert--plist-difference-explanation
'(a b c t) '(c nil a b))
- '(different-properties-for-key c (different-types t nil))))
+ '(different-properties-for-key c (different-atoms t nil))))
(should (equal (ert--plist-difference-explanation
'(a b c (foo . bar)) '(c (foo . baz) a b))
'(different-properties-for-key c
@@ -778,7 +778,7 @@ This macro is used to test if macroexpansion in `should'
works."
#("foo" 0 1 (a b))
"foo")
'(char 0 "f"
- (different-properties-for-key a (different-types b
nil))
+ (different-properties-for-key a (different-atoms b
nil))
context-before ""
context-after "oo")))
(should (equal (ert--explain-equal-including-properties-rec