aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/comp.c2
-rw-r--r--src/data.c40
-rw-r--r--src/lisp.h6
-rw-r--r--src/puresize.h2
-rw-r--r--src/sqlite.c17
5 files changed, 45 insertions, 22 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)
2442 { 2442 {
2443 Lisp_Object arg1 = arg[1]; 2443 Lisp_Object arg1 = arg[1];
2444 2444
2445 if (EQ (Ftype_of (arg1), Qcomp_mvar)) 2445 if (EQ (Fcl_type_of (arg1), Qcomp_mvar))
2446 res = emit_mvar_rval (arg1); 2446 res = emit_mvar_rval (arg1);
2447 else if (EQ (FIRST (arg1), Qcall)) 2447 else if (EQ (FIRST (arg1), Qcall))
2448 res = emit_limple_call (XCDR (arg1)); 2448 res = emit_limple_call (XCDR (arg1));
diff --git a/src/data.c b/src/data.c
index 35f4c82c68f..69b990bed76 100644
--- a/src/data.c
+++ b/src/data.c
@@ -193,16 +193,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0,
193DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, 193DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
194 doc: /* Return a symbol representing the type of OBJECT. 194 doc: /* Return a symbol representing the type of OBJECT.
195The symbol returned names the object's basic type; 195The symbol returned names the object's basic type;
196for example, (type-of 1) returns `integer'. */) 196for example, (type-of 1) returns `integer'.
197Contrary to `cl-type-of', the returned type is not always the most
198precise type possible, because instead this function tries to preserve
199compatibility with the return value of previous Emacs versions. */)
200 (Lisp_Object object)
201{
202 return SYMBOLP (object) ? Qsymbol
203 : INTEGERP (object) ? Qinteger
204 : SUBRP (object) ? Qsubr
205 : Fcl_type_of (object);
206}
207
208DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
209 doc: /* Return a symbol representing the type of OBJECT.
210The returned symbol names the most specific possible type of the object.
211for example, (cl-type-of nil) returns `null'.
212The specific type returned may change depending on Emacs versions,
213so we recommend you use `cl-typep', `cl-typecase', or other predicates
214rather than compare the return value of this function against
215a fixed set of types. */)
197 (Lisp_Object object) 216 (Lisp_Object object)
198{ 217{
199 switch (XTYPE (object)) 218 switch (XTYPE (object))
200 { 219 {
201 case_Lisp_Int: 220 case_Lisp_Int:
202 return Qinteger; 221 return Qfixnum;
203 222
204 case Lisp_Symbol: 223 case Lisp_Symbol:
205 return Qsymbol; 224 return NILP (object) ? Qnull
225 : EQ (object, Qt) ? Qboolean
226 : Qsymbol;
206 227
207 case Lisp_String: 228 case Lisp_String:
208 return Qstring; 229 return Qstring;
@@ -215,7 +236,7 @@ for example, (type-of 1) returns `integer'. */)
215 switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) 236 switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
216 { 237 {
217 case PVEC_NORMAL_VECTOR: return Qvector; 238 case PVEC_NORMAL_VECTOR: return Qvector;
218 case PVEC_BIGNUM: return Qinteger; 239 case PVEC_BIGNUM: return Qbignum;
219 case PVEC_MARKER: return Qmarker; 240 case PVEC_MARKER: return Qmarker;
220 case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; 241 case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos;
221 case PVEC_OVERLAY: return Qoverlay; 242 case PVEC_OVERLAY: return Qoverlay;
@@ -224,7 +245,10 @@ for example, (type-of 1) returns `integer'. */)
224 case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; 245 case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
225 case PVEC_PROCESS: return Qprocess; 246 case PVEC_PROCESS: return Qprocess;
226 case PVEC_WINDOW: return Qwindow; 247 case PVEC_WINDOW: return Qwindow;
227 case PVEC_SUBR: return Qsubr; 248 case PVEC_SUBR:
249 return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
250 : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
251 : Qprimitive_function;
228 case PVEC_COMPILED: return Qcompiled_function; 252 case PVEC_COMPILED: return Qcompiled_function;
229 case PVEC_BUFFER: return Qbuffer; 253 case PVEC_BUFFER: return Qbuffer;
230 case PVEC_CHAR_TABLE: return Qchar_table; 254 case PVEC_CHAR_TABLE: return Qchar_table;
@@ -4202,7 +4226,9 @@ syms_of_data (void)
4202 "Variable binding depth exceeds max-specpdl-size"); 4226 "Variable binding depth exceeds max-specpdl-size");
4203 4227
4204 /* Types that type-of returns. */ 4228 /* Types that type-of returns. */
4229 DEFSYM (Qboolean, "boolean");
4205 DEFSYM (Qinteger, "integer"); 4230 DEFSYM (Qinteger, "integer");
4231 DEFSYM (Qbignum, "bignum");
4206 DEFSYM (Qsymbol, "symbol"); 4232 DEFSYM (Qsymbol, "symbol");
4207 DEFSYM (Qstring, "string"); 4233 DEFSYM (Qstring, "string");
4208 DEFSYM (Qcons, "cons"); 4234 DEFSYM (Qcons, "cons");
@@ -4218,6 +4244,9 @@ syms_of_data (void)
4218 DEFSYM (Qprocess, "process"); 4244 DEFSYM (Qprocess, "process");
4219 DEFSYM (Qwindow, "window"); 4245 DEFSYM (Qwindow, "window");
4220 DEFSYM (Qsubr, "subr"); 4246 DEFSYM (Qsubr, "subr");
4247 DEFSYM (Qspecial_form, "special-form");
4248 DEFSYM (Qprimitive_function, "primitive-function");
4249 DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
4221 DEFSYM (Qcompiled_function, "compiled-function"); 4250 DEFSYM (Qcompiled_function, "compiled-function");
4222 DEFSYM (Qbuffer, "buffer"); 4251 DEFSYM (Qbuffer, "buffer");
4223 DEFSYM (Qframe, "frame"); 4252 DEFSYM (Qframe, "frame");
@@ -4255,6 +4284,7 @@ syms_of_data (void)
4255 defsubr (&Seq); 4284 defsubr (&Seq);
4256 defsubr (&Snull); 4285 defsubr (&Snull);
4257 defsubr (&Stype_of); 4286 defsubr (&Stype_of);
4287 defsubr (&Scl_type_of);
4258 defsubr (&Slistp); 4288 defsubr (&Slistp);
4259 defsubr (&Snlistp); 4289 defsubr (&Snlistp);
4260 defsubr (&Sconsp); 4290 defsubr (&Sconsp);
diff --git a/src/lisp.h b/src/lisp.h
index f353e4956eb..f86758c88fb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -569,10 +569,8 @@ enum Lisp_Fwd_Type
569 your object -- this way, the same object could be used to represent 569 your object -- this way, the same object could be used to represent
570 several disparate C structures. 570 several disparate C structures.
571 571
572 In addition, you need to add switch branches in data.c for Ftype_of. 572 In addition, you need to add switch branches in data.c for Fcl_type_of
573 573 and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */
574 You also need to add the new type to the constant
575 `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */
576 574
577 575
578/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a 576/* 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
47#endif 47#endif
48 48
49#ifndef BASE_PURESIZE 49#ifndef BASE_PURESIZE
50#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) 50#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
51#endif 51#endif
52 52
53/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ 53/* 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)
349 value = XCAR (values); 349 value = XCAR (values);
350 values = XCDR (values); 350 values = XCDR (values);
351 } 351 }
352 Lisp_Object type = Ftype_of (value); 352 if (STRINGP (value))
353
354 if (EQ (type, Qstring))
355 { 353 {
356 Lisp_Object encoded; 354 Lisp_Object encoded;
357 bool blob = false; 355 bool blob = false;
@@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
385 SSDATA (encoded), SBYTES (encoded), 383 SSDATA (encoded), SBYTES (encoded),
386 NULL); 384 NULL);
387 } 385 }
388 else if (EQ (type, Qinteger)) 386 else if (FIXNUMP (value))
389 { 387 ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
390 if (BIGNUMP (value)) 388 else if (BIGNUMP (value))
391 ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); 389 ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
392 else 390 else if (FLOATP (value))
393 ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
394 }
395 else if (EQ (type, Qfloat))
396 ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value)); 391 ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
397 else if (NILP (value)) 392 else if (NILP (value))
398 ret = sqlite3_bind_null (stmt, i + 1); 393 ret = sqlite3_bind_null (stmt, i + 1);