summaryrefslogtreecommitdiff
path: root/src/data.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c117
1 files changed, 63 insertions, 54 deletions
diff --git a/src/data.c b/src/data.c
index 0c47750cb75..c4b9cff8ae0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <math.h>
#include <stdio.h>
-#include <byteswap.h>
#include <count-one-bits.h>
#include <count-trailing-zeros.h>
#include <intprops.h>
@@ -193,16 +192,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;
@@ -211,11 +231,11 @@ for example, (type-of 1) returns `integer'. */)
return Qcons;
case Lisp_Vectorlike:
- /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */
+ /* WARNING!! Keep 'cl--type-hierarchy' in sync with this code!! */
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,13 +244,17 @@ 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
+ : Qprimitive_function;
case PVEC_COMPILED: return Qcompiled_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
+ case PVEC_OBARRAY: return Qobarray;
case PVEC_FONT:
if (FONT_SPEC_P (object))
return Qfont_spec;
@@ -338,7 +362,8 @@ DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0,
}
DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a symbol together with position. */
+ doc: /* Return t if OBJECT is a symbol together with position.
+Ignore `symbols-with-pos-enabled'. */
attributes: const)
(Lisp_Object object)
{
@@ -788,55 +813,54 @@ Doing that might make Emacs dysfunctional, and might even crash Emacs. */)
}
DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
- doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */)
+ doc: /* Extract, if need be, the bare symbol from SYM.
+SYM is either a symbol or a symbol with position.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym)
{
if (BARE_SYMBOL_P (sym))
return sym;
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_SYM (sym);
+ if (SYMBOL_WITH_POS_P (sym))
+ return XSYMBOL_WITH_POS_SYM (sym);
+ xsignal2 (Qwrong_type_argument, list2 (Qsymbolp, Qsymbol_with_pos_p), sym);
}
DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0,
- doc: /* Extract the position from a symbol with position. */)
- (register Lisp_Object ls)
+ doc: /* Extract the position from the symbol with position SYMPOS.
+Ignore `symbols-with-pos-enabled'. */)
+ (register Lisp_Object sympos)
{
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_POS (ls);
+ CHECK_TYPE (SYMBOL_WITH_POS_P (sympos), Qsymbol_with_pos_p, sympos);
+ return XSYMBOL_WITH_POS_POS (sympos);
}
DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol,
Sremove_pos_from_symbol, 1, 1, 0,
doc: /* If ARG is a symbol with position, return it without the position.
-Otherwise, return ARG unchanged. Compare with `bare-symbol'. */)
+Otherwise, return ARG unchanged. Ignore `symbols-with-pos-enabled'.
+Compare with `bare-symbol'. */)
(register Lisp_Object arg)
{
if (SYMBOL_WITH_POS_P (arg))
- return (SYMBOL_WITH_POS_SYM (arg));
+ return XSYMBOL_WITH_POS_SYM (arg);
return arg;
}
DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0,
- doc: /* Create a new symbol with position.
+ doc: /* Make a new symbol with position.
SYM is a symbol, with or without position, the symbol to position.
-POS, the position, is either a fixnum or a symbol with position from which
-the position will be taken. */)
+POS, the position, is either a nonnegative fixnum,
+or a symbol with position from which the position will be taken.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym, register Lisp_Object pos)
{
- Lisp_Object bare;
+ Lisp_Object bare = Fbare_symbol (sym);
Lisp_Object position;
- if (BARE_SYMBOL_P (sym))
- bare = sym;
- else if (SYMBOL_WITH_POS_P (sym))
- bare = XSYMBOL_WITH_POS (sym)->sym;
- else
- wrong_type_argument (Qsymbolp, sym);
-
if (FIXNUMP (pos))
position = pos;
else if (SYMBOL_WITH_POS_P (pos))
- position = XSYMBOL_WITH_POS (pos)->pos;
+ position = XSYMBOL_WITH_POS_POS (pos);
else
wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos);
@@ -3810,30 +3834,6 @@ count_trailing_zero_bits (bits_word val)
}
}
-static bits_word
-bits_word_to_host_endian (bits_word val)
-{
-#ifndef WORDS_BIGENDIAN
- return val;
-#else
- if (BITS_WORD_MAX >> 31 == 1)
- return bswap_32 (val);
- if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
- return bswap_64 (val);
- {
- int i;
- bits_word r = 0;
- for (i = 0; i < sizeof val; i++)
- {
- r = ((r << 1 << (CHAR_BIT - 1))
- | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
- val = val >> 1 >> (CHAR_BIT - 1);
- }
- return r;
- }
-#endif
-}
-
DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or,
Sbool_vector_exclusive_or, 2, 3, 0,
doc: /* Return A ^ B, bitwise exclusive or.
@@ -4047,6 +4047,7 @@ syms_of_data (void)
DEFSYM (Qminibuffer_quit, "minibuffer-quit");
DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
+ DEFSYM (Qtype_mismatch, "type-mismatch")
DEFSYM (Qargs_out_of_range, "args-out-of-range");
DEFSYM (Qvoid_function, "void-function");
DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection");
@@ -4138,6 +4139,7 @@ syms_of_data (void)
PUT_ERROR (Quser_error, error_tail, "");
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
+ PUT_ERROR (Qtype_mismatch, error_tail, "Types do not match");
PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
PUT_ERROR (Qvoid_function, error_tail,
"Symbol's function definition is void");
@@ -4201,7 +4203,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");
@@ -4217,6 +4221,9 @@ syms_of_data (void)
DEFSYM (Qprocess, "process");
DEFSYM (Qwindow, "window");
DEFSYM (Qsubr, "subr");
+ DEFSYM (Qspecial_form, "special-form");
+ DEFSYM (Qprimitive_function, "primitive-function");
+ DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
@@ -4238,6 +4245,7 @@ syms_of_data (void)
DEFSYM (Qtreesit_parser, "treesit-parser");
DEFSYM (Qtreesit_node, "treesit-node");
DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query");
+ DEFSYM (Qobarray, "obarray");
DEFSYM (Qdefun, "defun");
@@ -4253,6 +4261,7 @@ syms_of_data (void)
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
+ defsubr (&Scl_type_of);
defsubr (&Slistp);
defsubr (&Snlistp);
defsubr (&Sconsp);
@@ -4381,7 +4390,7 @@ This variable cannot be set; trying to do so will signal an error. */);
DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled");
DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled,
- doc: /* Non-nil when "symbols with position" can be used as symbols.
+ doc: /* If non-nil, a symbol with position ordinarily behaves as its bare symbol.
Bind this to non-nil in applications such as the byte compiler. */);
symbols_with_pos_enabled = false;
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-19 15:44:26 +0000