From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#69739: 30.0.50; `type-of` is not precise enough Date: Sun, 17 Mar 2024 18:29:10 -0400 Message-ID: References: <86o7bjtuvj.fsf@gnu.org> <86il1rtrvm.fsf@gnu.org> <86a5n2tkga.fsf@gnu.org> <877ci3stzu.fsf@epfl.ch> <86zfuz7cbw.fsf@gnu.org> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="32420"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: acorallo@gnu.org, basil@contovou.net, 69739@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Mar 17 23:29:52 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rlz0p-0008Gp-B8 for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 17 Mar 2024 23:29:51 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rlz0R-00026O-MW; Sun, 17 Mar 2024 18:29:27 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rlz0Q-00026E-7c for bug-gnu-emacs@gnu.org; Sun, 17 Mar 2024 18:29:26 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rlz0P-000833-Vf for bug-gnu-emacs@gnu.org; Sun, 17 Mar 2024 18:29:26 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rlz11-0002jn-AM for bug-gnu-emacs@gnu.org; Sun, 17 Mar 2024 18:30:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 17 Mar 2024 22:30:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69739 X-GNU-PR-Package: emacs Original-Received: via spool by 69739-submit@debbugs.gnu.org id=B69739.171071460110488 (code B ref 69739); Sun, 17 Mar 2024 22:30:03 +0000 Original-Received: (at 69739) by debbugs.gnu.org; 17 Mar 2024 22:30:01 +0000 Original-Received: from localhost ([127.0.0.1]:43641 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rlz0y-0002j1-1W for submit@debbugs.gnu.org; Sun, 17 Mar 2024 18:30:01 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:21684) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rlz0v-0002ic-FT for 69739@debbugs.gnu.org; Sun, 17 Mar 2024 18:29:58 -0400 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id D41F380DB3; Sun, 17 Mar 2024 18:29:13 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1710714551; bh=WT21MX+SQpSWK3shHl5wbE6pL1ztiZ89Bs/H8Laa56M=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=ME26K8luoYu94ToIRO3i07oQ9uX71ciF5fUvRihgUcXUwYNw3kg9kK2ueTdS0JlX8 1No8GU7CJgSh7R1eBGLMzn5B5d0bnTXgX8wjfwFTCsbQkOivO6sU9fzGGHkYdpY3y5 PrIQsb9PvGvsn9gTh8BYl79tBBm6QNWyOHxelKuKxLTYqkMhpi97tlhLstgY42Me8o SMnjY6JjPlaUeAmJj9tPo2KNYjexsKJGwA0tXrsMhCMa8stwFu3g6UI01SAzNNBlDm fbfhQqutWMOpDcFwOnP2alY5siciH5rY1fg+Y5irybocSVSCjim32ReX08nze9QWP1 sAXBKcHmjfskw== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 42BD380C8F; Sun, 17 Mar 2024 18:29:11 -0400 (EDT) Original-Received: from alfajor (unknown [104.247.238.200]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 04B0D120667; Sun, 17 Mar 2024 18:29:10 -0400 (EDT) In-Reply-To: <86zfuz7cbw.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 15 Mar 2024 17:18:43 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:281785 Archived-At: --=-=-= Content-Type: text/plain > Yes, I think we should document it near type-of, as the explanation > when and why to prefer cl-type-of is quite simple and easily > understandable. OK, here's a new (set of) patches (also available in the `scratch/object-type` branch). I added the doc as well as a test (which pointed to the `subr-primitive-p` problem), and an additional hunk which fixes the `subr-primitive-p`. Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-cl-type-of-New-function-to-return-more-precise-types.patch >From 3917c4be34f5c1d6249da474337f8f23544dcc9b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 09:26:24 -0400 Subject: [PATCH 1/3] (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. --- doc/lispref/objects.texi | 21 +++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/cl-generic.el | 6 ++--- lisp/emacs-lisp/cl-preloaded.el | 12 +++++----- lisp/emacs-lisp/eieio-core.el | 2 +- src/comp.c | 2 +- src/data.c | 40 ++++++++++++++++++++++++++++----- test/src/data-tests.el | 37 ++++++++++++++++++++++++++++++ 8 files changed, 108 insertions(+), 17 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 279f449a994..6e92f9bcc2a 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2207,6 +2207,27 @@ Type Predicates @end example @end defun +@defun cl-type-of 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 also +implies 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 b02712dd21c..b522fbd338b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1647,6 +1647,11 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'cl-type-of'. +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 613ecf82a92..62abe8d1589 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1334,8 +1334,7 @@ cl-generic-generalizers (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,8 +1344,7 @@ cl--generic-type-specializers (cl--class-allparents class))))) (cl-generic-define-generalizer cl--generic-typeof-generalizer - ;; FIXME: We could also change `type-of' to return `null' for nil. - 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) + 10 (lambda (name &rest _) `(cl-type-of ,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 515aa99549d..3e89afea452 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -339,8 +339,6 @@ cl--define-built-in-type ',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', @@ -428,15 +426,17 @@ compiled-function "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) "Type of functions that have been byte-compiled.") -(cl--define-built-in-type subr (compiled-function) +(cl--define-built-in-type subr (atom) "Abstract type of functions compiled to machine code.") (cl--define-built-in-type module-function (function) "Type of functions provided via the module API.") (cl--define-built-in-type interpreted-function (function) "Type of functions that have not been compiled.") -(cl--define-built-in-type subr-native-elisp (subr) - "Type of function that have been compiled by the native compiler.") -(cl--define-built-in-type subr-primitive (subr) +(cl--define-built-in-type special-form (subr) + "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) "Type of functions hand written in C.") (unless (cl--class-parents (cl--find-class 'cl-structure-object)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index a2f7c4172a3..cf8bd749f2a 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1046,7 +1046,7 @@ 'inconsistent-class-hierarchy (defun cl--generic-struct-tag (name &rest _) ;; Use exactly the same code as for `typeof'. - `(if ,name (type-of ,name) 'null)) + `(cl-type-of ,name)) (cl-generic-define-generalizer eieio--generic-generalizer ;; Use the exact same tagcode as for cl-struct, so that methods 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..a961dd3108c 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 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 Qsymbol; + return NILP (object) ? Qnull + : EQ (object, Qt) ? Qboolean + : Qsymbol; case Lisp_String: return Qstring; @@ -215,7 +236,7 @@ DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, 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 @@ DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, 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 @@ #define PUT_ERROR(sym, tail, msg) \ "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 @@ #define PUT_ERROR(sym, tail, msg) \ 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 @@ #define PUT_ERROR(sym, tail, msg) \ defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); + defsubr (&Scl_type_of); defsubr (&Slistp); defsubr (&Snlistp); defsubr (&Sconsp); diff --git a/test/src/data-tests.el b/test/src/data-tests.el index ad3b2071254..9d76c58224d 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -838,4 +838,41 @@ data-tests-bare-symbol (dolist (sym (list nil t 'xyzzy (make-symbol ""))) (should (eq sym (bare-symbol (position-symbol sym 0))))))) +(require 'cl-extra) ;For `cl--class-children'. + +(ert-deftest data-tests--cl-type-of () + ;; Make sure that `cl-type-of' returns the most precise type. + ;; Note: This doesn't work for list/vector structs since those types + ;; are too difficult/unreliable to detect (so `cl-type-of' only says + ;; it's a `cons' or a `vector'). + (dolist (val (list -2 10 (expt 2 128) nil t 'car + (symbol-function 'car) + (symbol-function 'progn) + (position-symbol 'car 7))) + (let* ((type (cl-type-of val)) + (class (cl-find-class type)) + (alltypes (cl--class-allparents class)) + ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'. + ;; (e.g. `symbolp' returns nil on a sympos if that var is nil). + (symbols-with-pos-enabled t)) + (dolist (parent alltypes) + (should (cl-typep val parent)) + (dolist (subtype (cl--class-children (cl-find-class parent))) + (unless (memq subtype alltypes) + (unless (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + 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)) + (should-not (cl-typep val subtype))))))))) + + ;;; data-tests.el ends here -- 2.43.0 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-primitive-function-New-type.patch >From 41184670fd4b720350da58f6051212e5cb3ea7a7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 17 Mar 2024 17:29:02 -0400 Subject: [PATCH 2/3] (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 @@ special-form "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 @@ unless 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 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, 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 @@ #define PUT_ERROR(sym, tail, msg) \ 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 @@ data-tests--cl-type-of 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))))))))) -- 2.43.0 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0003-Followup-changes-to-cl-type-of.patch >From 3bab41044eb2c3c9ec373eae4efb92832c2fe6c3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 12:49:08 -0400 Subject: [PATCH 3/3] Followup changes to `cl-type-of` These changes came up while working on `cl-type-of` but are not directly related to the new `cl-type-of`. The BASE_PURESIZE bump was needed at some point on one of my machine, not sure why. * src/puresize.h (BASE_PURESIZE): Bump up. * src/sqlite.c (bind_value): Don't use `Ftype_of`. * lisp/emacs-lisp/seq.el (seq-remove-at-position): Simplify. * lisp/emacs-lisp/cl-preloaded.el (finalizer): New (previously missing) type. * doc/lispref/objects.texi (Type Predicates): Minor tweaks. --- doc/lispref/objects.texi | 6 +++--- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/seq.el | 3 +-- src/lisp.h | 6 ++---- src/puresize.h | 2 +- src/sqlite.c | 17 ++++++----------- 6 files changed, 14 insertions(+), 21 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 6e92f9bcc2a..50dddf9f0e5 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1485,8 +1485,8 @@ Type Descriptors @subsection Type Descriptors A @dfn{type descriptor} is a @code{record} which holds information -about a type. Slot 1 in the record must be a symbol naming the type, and -@code{type-of} relies on this to return the type of @code{record} +about a type. The first slot in the record must be a symbol naming the type, +and @code{type-of} relies on this to return the type of @code{record} objects. No other type descriptor slot is used by Emacs; they are free for use by Lisp extensions. @@ -2175,7 +2175,7 @@ Type Predicates 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 diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d11c97a3e3a..cba56e0bbd4 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -365,6 +365,7 @@ frame (cl--define-built-in-type buffer atom) (cl--define-built-in-type window atom) (cl--define-built-in-type process atom) +(cl--define-built-in-type finalizer atom) (cl--define-built-in-type window-configuration atom) (cl--define-built-in-type overlay atom) (cl--define-built-in-type number-or-marker atom diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 20077db9e60..a20cff16982 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -362,8 +362,7 @@ seq-remove-at-position The result is a sequence of the same type as SEQUENCE." (seq-concatenate - (let ((type (type-of sequence))) - (if (eq type 'cons) 'list type)) + (if (listp sequence) 'list (type-of sequence)) (seq-subseq sequence 0 n) (seq-subseq sequence (1+ n)))) 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 @@ #define ENUM_BF(TYPE) enum 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 Fcl_type_of + 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 @@ #define SITELOAD_PURESIZE_EXTRA 0 #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); -- 2.43.0 --=-=-=--