From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.devel Subject: Making 'eq' == 'eql' in bignum branch Date: Fri, 27 Jul 2018 14:14:59 -0700 Organization: UCLA Computer Science Department Message-ID: <76081b5d-8c10-0a37-2c97-d4864c0faa80@cs.ucla.edu> References: <29f933ac-a6bf-8742-66a7-0a9d6d3e5a88@disroot.org> <83bmecy6fx.fsf@gnu.org> <0d3175d8-d996-651e-b221-71978bde3a65@cs.ucla.edu> <87tvpdnzgy.fsf@tromey.com> <4c2a814f-c254-29e5-39cf-11b5f2e5c9c8@cs.ucla.edu> <49d8ba62-c9a5-9203-d882-8e900b441ff3@cs.ucla.edu> <8e0320d9-e0d0-2b57-57cc-2df4399f133c@cs.ucla.edu> <87lgaio7xd.fsf@tromey.com> <877em1cb0i.fsf@tromey.com> <765767b2-d2e5-a9a6-f724-d58ecf4847bb@cs.ucla.edu> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------F38975F16104A1503108D086" X-Trace: blaine.gmane.org 1532726048 27272 195.159.176.226 (27 Jul 2018 21:14:08 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 27 Jul 2018 21:14:08 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.9.1 Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Jul 27 23:14:04 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fjA3n-00071D-RM for ged-emacs-devel@m.gmane.org; Fri, 27 Jul 2018 23:14:04 +0200 Original-Received: from localhost ([::1]:43015 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fjA5u-0007UY-Jw for ged-emacs-devel@m.gmane.org; Fri, 27 Jul 2018 17:16:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57870) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fjA4r-0007Pc-7l for emacs-devel@gnu.org; Fri, 27 Jul 2018 17:15:13 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fjA4n-0003fv-HG for emacs-devel@gnu.org; Fri, 27 Jul 2018 17:15:09 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:42518) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fjA4m-0003eH-Ur for emacs-devel@gnu.org; Fri, 27 Jul 2018 17:15:05 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 8CB7F1610C6; Fri, 27 Jul 2018 14:15:03 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id KJSY8Zsa3br2; Fri, 27 Jul 2018 14:15:00 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id DA942161129; Fri, 27 Jul 2018 14:15:00 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id OOl7kErMVsFp; Fri, 27 Jul 2018 14:15:00 -0700 (PDT) Original-Received: from [192.168.1.9] (unknown [47.154.30.119]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id 756D01610C6; Fri, 27 Jul 2018 14:15:00 -0700 (PDT) Openpgp: preference=signencrypt Autocrypt: addr=eggert@cs.ucla.edu; prefer-encrypt=mutual; keydata= xsFNBEyAcmQBEADAAyH2xoTu7ppG5D3a8FMZEon74dCvc4+q1XA2J2tBy2pwaTqfhpxxdGA9 Jj50UJ3PD4bSUEgN8tLZ0san47l5XTAFLi2456ciSl5m8sKaHlGdt9XmAAtmXqeZVIYX/UFS 96fDzf4xhEmm/y7LbYEPQdUdxu47xA5KhTYp5bltF3WYDz1Ygd7gx07Auwp7iw7eNvnoDTAl KAl8KYDZzbDNCQGEbpY3efZIvPdeI+FWQN4W+kghy+P6au6PrIIhYraeua7XDdb2LS1en3Ss mE3QjqfRqI/A2ue8JMwsvXe/WK38Ezs6x74iTaqI3AFH6ilAhDqpMnd/msSESNFt76DiO1ZK QMr9amVPknjfPmJISqdhgB1DlEdw34sROf6V8mZw0xfqT6PKE46LcFefzs0kbg4GORf8vjG2 Sf1tk5eU8MBiyN/bZ03bKNjNYMpODDQQwuP84kYLkX2wBxxMAhBxwbDVZudzxDZJ1C2VXujC OJVxq2kljBM9ETYuUGqd75AW2LXrLw6+MuIsHFAYAgRr7+KcwDgBAfwhPBYX34nSSiHlmLC+ KaHLeCLF5ZI2vKm3HEeCTtlOg7xZEONgwzL+fdKo+D6SoC8RRxJKs8a3sVfI4t6CnrQzvJbB n6gxdgCu5i29J1QCYrCYvql2UyFPAK+do99/1jOXT4m2836j1wARAQABzSBQYXVsIEVnZ2Vy dCA8ZWdnZXJ0QGNzLnVjbGEuZWR1PsLBfgQTAQIAKAUCTIByZAIbAwUJEswDAAYLCQgHAwIG FQgCCQoLBBYCAwECH In-Reply-To: Content-Language: en-US X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 131.179.128.68 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:227882 Archived-At: This is a multi-part message in MIME format. --------------F38975F16104A1503108D086 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: quoted-printable Ten days ago we were discussing the possibility of changing eq to be equi= valent=20 to eql in the bignum branch, to avoid possible compability issues where '= eq' no=20 longer agrees with 'eql' (or with '=3D') on integer arguments. On July 18= Stefan=20 wrote: > Some uses of EQ admittedly don't need to be > redirected to EQL, so we could improve the patch to reduce its cost, bu= t > I expect the benefit would be small. It's more than "some", if we count static occurrences. Almost all uses of= EQ in=20 C code don't need to be redirected to EQL, because one can easily tell=20 statically that at least one of the arguments must be a non-float, or tha= t it's=20 OK to use pointer comparison for some other reason. I wrote a patch along= those=20 lines (see attached; it's against the master branch), and when compiled w= ith=20 normal -O2 optimization (Fedora 28 x86-64, AMD Phenom II X4 910e, user+sy= stem=20 time, average of 3 runs), "cd lisp; make compile-always" suffers only a 2= .3%=20 slowdown, better than the 4% slowdown Stefan mentioned with his simpler p= atch. Stefan, have you thought about hashing floating-point objects instead, so= that=20 comparing pointers suffices for eql, and eq becomes equivalent to eql in = a=20 different way? That may well have better performance for typical Emacs=20 applications, since they typically don't create a lot of floating-point n= umbers.=20 Also, it'd be less error-prone than the attached patch, which involves st= atic=20 analysis that would typically be done by hand. >> Also, the C code will need to change how hashing works since XHASH >> etc. must be consistent with eq. > > The patch does that already, AFAIK. I still see a problem there in your simpler patch, since cmpfn_eql isn't = used in=20 the eq case, when hashing floating-point values. >> I worry that the benchmark isn't realistic enough, as some usage of E= Q in >> C code will need to change to Feql or equivalent. > > I don't understand what you mean: the patch changes `EQ` itself: > > -# define EQ(x, y) lisp_h_EQ (x, y) > +# define EQ(x, y) EQL (x, y) > > where EQL is the same as Feql (except it returns a boolean instead of > a Lisp_Object). You're right. Sorry, I missed that. --------------F38975F16104A1503108D086 Content-Type: text/x-patch; name="0001-Make-eq-act-like-eql.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="0001-Make-eq-act-like-eql.patch" =46rom 91c48f71f4e1a86eceae39642bc88b2781e9bbe4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 27 Jul 2018 13:41:10 -0700 Subject: [PATCH] Make eq act like eql This patch changes the Lisp function eq to act like eql. The goal is to simplify the introduction of bignums, so that eq will still be equivalent to eql on integers. This patch tests this by doing so for floating-point numbers. * lisp/subr.el (memq, sxhash-eq): Now aliases for the corresponding eql fns. * src/bytecode.c (exec_byte_code): * src/category.c (word_boundary_p): * src/chartab.c (sub_char_table_ref_and_range) (char_table_ref_and_range, optimize_sub_char_table) (map_sub_char_table, uniprop_encode_value_run_length) (unicode_encode_value_numeric): * src/data.c (Feq, set_internal, set_default_internal): * src/dispnew.c (Fframe_or_buffer_changed_p): * src/emacs-module.c (module_eq): * src/eval.c (defvaralias, macroexpand, Fthrow) (process_quit_flag): * src/fns.c (Fmember, Fassq, Frassq, Fdelq, Fplist_get) (Fplist_put, Fplist_member, hash_lookup, hash_remove_from_table): * src/textprop.c (interval_has_all_properties) (interval_has_some_properties, interval_has_some_properties_list) (property_value, set_properties, add_properties, remove_properties) (Fnext_single_char_property_change) (Fprevious_single_char_property_change) (Fnext_single_property_change) (Fprevious_single_property_change, Ftext_property_any) (Ftext_property_not_all, copy_text_properties, text_property_list): Use EQL, not EQ, on values not known to be safe for EQ. * src/fns.c (WORDS_PER_DOUBLE, union double_and_words) (same_float): Move to src/lisp.h. (Fmemql): Remove; now written in Lisp. (Feql): Rewrite in terms of EQL. (assq_no_quit): Add an assertion that the key is not a float. (cmpfn_eql, hashfn_eq): Remove; all uses removed. (sxhash_float): Now extern. Accept Lisp float, not double. All uses changed. (Fsxhash_eql): Remove; all uses removed. (Fmake_hash_table): Do the same thing for eql as for eq. * src/lisp.h (lisp_h_XHASH): Look at contents of floats. (same_float): Now INLINE. (EQL): New function. * src/window.c (window_wants_mode_line, window_wants_header_line): Rewrite to avoid GCC warning. --- lisp/subr.el | 3 ++ src/bytecode.c | 4 +- src/category.c | 4 +- src/chartab.c | 18 +++---- src/data.c | 7 +-- src/dispnew.c | 2 +- src/emacs-module.c | 2 +- src/eval.c | 10 ++-- src/fns.c | 123 +++++++++------------------------------------ src/lisp.h | 43 +++++++++++++++- src/textprop.c | 38 +++++++------- src/window.c | 10 ++-- 12 files changed, 116 insertions(+), 148 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 6b30371a86..2ffaa79762 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -680,6 +680,9 @@ assoc-default (setq tail (cdr tail))) value)) =20 +(defalias 'memql 'memq) +(defalias 'sxhash-eql 'sxhash-eq) + (defun member-ignore-case (elt list) "Like `member', but ignore differences in case and text representation= =2E ELT must be a string. Upper-case and lower-case letters are treated as = equal. diff --git a/src/bytecode.c b/src/bytecode.c index 772cc982f9..8e4eeddc89 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -518,7 +518,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vect= or, Lisp_Object maxdepth, CASE (Beq): { Lisp_Object v1 =3D POP; - TOP =3D EQ (v1, TOP) ? Qt : Qnil; + TOP =3D EQL (v1, TOP) ? Qt : Qnil; NEXT; } =20 @@ -1418,7 +1418,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object ve= ctor, Lisp_Object maxdepth, ? make_number (h->test.hashfn (&h->test, v1)) : Qnil; =20 for (i =3D h->count; 0 <=3D --i; ) - if (EQ (v1, HASH_KEY (h, i)) + if (EQL (v1, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) && h->test.cmpfn (&h->test, v1, HASH_KEY (h, i= )))) diff --git a/src/category.c b/src/category.c index 62bb7f1a6c..c84b747c13 100644 --- a/src/category.c +++ b/src/category.c @@ -397,8 +397,8 @@ word_boundary_p (int c1, int c2) Lisp_Object tail; bool default_result; =20 - if (EQ (CHAR_TABLE_REF (Vchar_script_table, c1), - CHAR_TABLE_REF (Vchar_script_table, c2))) + if (EQL (CHAR_TABLE_REF (Vchar_script_table, c1), + CHAR_TABLE_REF (Vchar_script_table, c2))) { tail =3D Vword_separating_categories; default_result =3D 0; diff --git a/src/chartab.c b/src/chartab.c index 89983503ac..d169400cbd 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -283,7 +283,7 @@ sub_char_table_ref_and_range (Lisp_Object table, int = c, int *from, int *to, else if (NILP (this_val)) this_val =3D defalt; =20 - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *from =3D c + 1; break; @@ -304,7 +304,7 @@ sub_char_table_ref_and_range (Lisp_Object table, int = c, int *from, int *to, is_uniprop); else if (NILP (this_val)) this_val =3D defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *to =3D c - 1; break; @@ -356,7 +356,7 @@ char_table_ref_and_range (Lisp_Object table, int c, i= nt *from, int *to) else if (NILP (this_val)) this_val =3D tbl->defalt; =20 - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *from =3D c + 1; break; @@ -376,7 +376,7 @@ char_table_ref_and_range (Lisp_Object table, int c, i= nt *from, int *to) tbl->defalt, is_uniprop); else if (NILP (this_val)) this_val =3D tbl->defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *to =3D c - 1; break; @@ -684,7 +684,7 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Obje= ct test) } if (optimizable && (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. *= / - : EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. *= / + : EQ (test, Qeq) ? !EQL (this, elt) /* Optimize `eq' case. *= / : NILP (call2 (test, this, elt)))) optimizable =3D 0; } @@ -791,7 +791,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, = Lisp_Object, Lisp_Object), { if (NILP (this)) this =3D XCHAR_TABLE (top)->defalt; - if (!EQ (val, this)) + if (!EQL (val, this)) { bool different_value =3D 1; =20 @@ -811,7 +811,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, = Lisp_Object, Lisp_Object), val =3D map_sub_char_table (c_function, function, parent, arg, val, range, parent); - if (EQ (val, this)) + if (EQL (val, this)) different_value =3D 0; } } @@ -1223,7 +1223,7 @@ uniprop_encode_value_run_length (Lisp_Object table,= Lisp_Object value) int i, size =3D ASIZE (XCHAR_TABLE (table)->extras[4]); =20 for (i =3D 0; i < size; i++) - if (EQ (value, value_table[i])) + if (EQL (value, value_table[i])) break; if (i =3D=3D size) wrong_type_argument (build_string ("Unicode property value"), value)= ; @@ -1242,7 +1242,7 @@ uniprop_encode_value_numeric (Lisp_Object table, Li= sp_Object value) =20 CHECK_NUMBER (value); for (i =3D 0; i < size; i++) - if (EQ (value, value_table[i])) + if (EQL (value, value_table[i])) break; value =3D make_number (i); if (i =3D=3D size) diff --git a/src/data.c b/src/data.c index c8beeda720..9777010e7f 100644 --- a/src/data.c +++ b/src/data.c @@ -186,7 +186,8 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0, attributes: const) (Lisp_Object obj1, Lisp_Object obj2) { - if (EQ (obj1, obj2)) + /* EQL not EQ, as Lisp eq is equivalent to Lisp eql. */ + if (EQL (obj1, obj2)) return Qt; return Qnil; } @@ -1316,7 +1317,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newva= l, Lisp_Object where, { case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) - || !EQ (newval, Fsymbol_value (symbol))) + || !EQL (newval, Fsymbol_value (symbol))) xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ @@ -1659,7 +1660,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Obje= ct value, { case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) - || !EQ (value, Fsymbol_value (symbol))) + || !EQL (value, Fsymbol_value (symbol))) xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ diff --git a/src/dispnew.c b/src/dispnew.c index fc6f9e2263..ae23c39e52 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5896,7 +5896,7 @@ pass nil for VARIABLE. */) goto changed; if (idx =3D=3D ASIZE (state)) goto changed; - if (!EQ (AREF (state, idx++), BVAR (XBUFFER (buf), read_only))) + if (!EQL (AREF (state, idx++), BVAR (XBUFFER (buf), read_only))) goto changed; if (idx =3D=3D ASIZE (state)) goto changed; diff --git a/src/emacs-module.c b/src/emacs-module.c index 5b9f6629e7..8fae36ec4f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -510,7 +510,7 @@ static bool module_eq (emacs_env *env, emacs_value a, emacs_value b) { MODULE_FUNCTION_BEGIN_NO_CATCH (false); - return EQ (value_to_lisp (a), value_to_lisp (b)); + return EQL (value_to_lisp (a), value_to_lisp (b)); } =20 static intmax_t diff --git a/src/eval.c b/src/eval.c index 5964dd1867..7a6e9bea6c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -628,8 +628,8 @@ The return value is BASE-VARIABLE. */) set_internal (base_variable, find_symbol_value (new_alias), Qnil, SET_INTERNAL_BIND); else if (!NILP (Fboundp (new_alias)) - && !EQ (find_symbol_value (new_alias), - find_symbol_value (base_variable))) + && !EQL (find_symbol_value (new_alias), + find_symbol_value (base_variable))) call2 (intern ("display-warning"), list3 (intern ("defvaralias"), intern ("losing-value"), new_a= lias), CALLN (Fformat_message, @@ -1067,7 +1067,7 @@ definitions to shadow the loaded ones for use in fi= le byte-compilation. */) } { Lisp_Object newform =3D apply1 (expander, XCDR (form)); - if (EQ (form, newform)) + if (EQL (form, newform)) break; else form =3D newform; @@ -1186,7 +1186,7 @@ Both TAG and VALUE are evalled. */ { if (c->type =3D=3D CATCHER_ALL) unwind_to_catch (c, Fcons (tag, value)); - if (c->type =3D=3D CATCHER && EQ (c->tag_or_ch, tag)) + if (c->type =3D=3D CATCHER && EQL (c->tag_or_ch, tag)) unwind_to_catch (c, value); } xsignal2 (Qno_catch, tag, value); @@ -1532,7 +1532,7 @@ process_quit_flag (void) Vquit_flag =3D Qnil; if (EQ (flag, Qkill_emacs)) Fkill_emacs (Qnil); - if (EQ (Vthrow_on_input, flag)) + if (EQL (Vthrow_on_input, flag)) Fthrow (Vthrow_on_input, Qt); quit (); } diff --git a/src/fns.c b/src/fns.c index 5247140ead..9a5fbdcdd8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1441,29 +1441,6 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, return Faref (sequence, n); } =20 -enum { WORDS_PER_DOUBLE =3D (sizeof (double) / sizeof (EMACS_UINT) - + (sizeof (double) % sizeof (EMACS_UINT) !=3D = 0)) }; -union double_and_words -{ - double val; - EMACS_UINT word[WORDS_PER_DOUBLE]; -}; - -/* Return true if X and Y are the same floating-point value. - This looks at X's and Y's representation, since (unlike '=3D=3D') - it returns true if X and Y are the same NaN. */ -static bool -same_float (Lisp_Object x, Lisp_Object y) -{ - union double_and_words - xu =3D { .val =3D XFLOAT_DATA (x) }, - yu =3D { .val =3D XFLOAT_DATA (y) }; - EMACS_UINT neql =3D 0; - for (int i =3D 0; i < WORDS_PER_DOUBLE; i++) - neql |=3D xu.word[i] ^ yu.word[i]; - return !neql; -} - DEFUN ("member", Fmember, Smember, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison = done with `equal'. The value is actually the tail of LIST whose car is ELT. */) @@ -1484,31 +1461,12 @@ The value is actually the tail of LIST whose car = is ELT. */) { Lisp_Object tail =3D list; FOR_EACH_TAIL (tail) - if (EQ (XCAR (tail), elt)) + if (EQL (XCAR (tail), elt)) return tail; CHECK_LIST_END (tail, list); return Qnil; } =20 -DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, - doc: /* Return non-nil if ELT is an element of LIST. Comparison = done with `eql'. -The value is actually the tail of LIST whose car is ELT. */) - (Lisp_Object elt, Lisp_Object list) -{ - if (!FLOATP (elt)) - return Fmemq (elt, list); - - Lisp_Object tail =3D list; - FOR_EACH_TAIL (tail) - { - Lisp_Object tem =3D XCAR (tail); - if (FLOATP (tem) && same_float (elt, tem)) - return tail; - } - CHECK_LIST_END (tail, list); - return Qnil; -} - DEFUN ("assq", Fassq, Sassq, 2, 2, 0, doc: /* Return non-nil if KEY is `eq' to the car of an element of= LIST. The value is actually the first element of LIST whose car is KEY. @@ -1517,18 +1475,20 @@ Elements of LIST that are not conses are ignored.= */) { Lisp_Object tail =3D list; FOR_EACH_TAIL (tail) - if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + if (CONSP (XCAR (tail)) && EQL (XCAR (XCAR (tail)), key)) return XCAR (tail); CHECK_LIST_END (tail, list); return Qnil; } =20 -/* Like Fassq but never report an error and do not allow quits. - Use only on objects known to be non-circular lists. */ +/* Like Fassq but never report an error and do not allow quits and use + EQ not EQL. Use only on objects known to be non-circular lists, + and where KEY is not a float. */ =20 Lisp_Object assq_no_quit (Lisp_Object key, Lisp_Object list) { + eassert (!FLOATP (key)); for (; ! NILP (list); list =3D XCDR (list)) if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key)) return XCAR (list); @@ -1581,7 +1541,7 @@ The value is actually the first element of LIST who= se cdr is KEY. */) { Lisp_Object tail =3D list; FOR_EACH_TAIL (tail) - if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) + if (CONSP (XCAR (tail)) && EQL (XCDR (XCAR (tail)), key)) return XCAR (tail); CHECK_LIST_END (tail, list); return Qnil; @@ -1621,7 +1581,7 @@ argument. */) FOR_EACH_TAIL (tail) { Lisp_Object tem =3D XCAR (tail); - if (EQ (elt, tem)) + if (EQL (elt, tem)) { if (NILP (prev)) list =3D XCDR (tail); @@ -2084,7 +2044,7 @@ properties on the list. This function never signal= s an error. */) { if (! CONSP (XCDR (tail))) break; - if (EQ (prop, XCAR (tail))) + if (EQL (prop, XCAR (tail))) return XCAR (XCDR (tail)); tail =3D XCDR (tail); if (EQ (tail, li.tortoise)) @@ -2123,7 +2083,7 @@ The PLIST is modified by side effects. */) if (! CONSP (XCDR (tail))) break; =20 - if (EQ (prop, XCAR (tail))) + if (EQL (prop, XCAR (tail))) { Fsetcar (XCDR (tail), val); return plist; @@ -2221,10 +2181,7 @@ This differs from numeric comparison: (eql 0.0 -0.= 0) returns nil and \(eql 0.0e+NaN 0.0e+NaN) returns t, whereas `=3D' does the opposite. */= ) (Lisp_Object obj1, Lisp_Object obj2) { - if (FLOATP (obj1)) - return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil; - else - return EQ (obj1, obj2) ? Qt : Qnil; + return EQL (obj1, obj2) ? Qt : Qnil; } =20 DEFUN ("equal", Fequal, Sequal, 2, 2, 0, @@ -2959,7 +2916,7 @@ The value is actually the tail of PLIST whose car i= s PROP. */) Lisp_Object tail =3D plist; FOR_EACH_TAIL (tail) { - if (EQ (XCAR (tail), prop)) + if (EQL (XCAR (tail), prop)) return tail; tail =3D XCDR (tail); if (! CONSP (tail)) @@ -3747,18 +3704,6 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t i= dx) return XINT (AREF (h->index, idx)); } =20 -/* Compare KEY1 and KEY2 in hash table HT using `eql'. Value is true - if KEY1 and KEY2 are the same. KEY1 and KEY2 must not be eq. */ - -static bool -cmpfn_eql (struct hash_table_test *ht, - Lisp_Object key1, - Lisp_Object key2) -{ - return FLOATP (key1) && FLOATP (key2) && same_float (key1, key2); -} - - /* Compare KEY1 and KEY2 in hash table HT using `equal'. Value is true if KEY1 and KEY2 are the same. */ =20 @@ -3770,7 +3715,6 @@ cmpfn_equal (struct hash_table_test *ht, return !NILP (Fequal (key1, key2)); } =20 - /* Compare KEY1 and KEY2 in hash table HT using HT->user_cmp_function. Value is true if KEY1 and KEY2 are the same. */ =20 @@ -3782,16 +3726,6 @@ cmpfn_user_defined (struct hash_table_test *ht, return !NILP (call2 (ht->user_cmp_function, key1, key2)); } =20 -/* Value is a hash code for KEY for use in hash table H which uses - `eq' to compare keys. The hash code returned is guaranteed to fit - in a Lisp integer. */ - -static EMACS_UINT -hashfn_eq (struct hash_table_test *ht, Lisp_Object key) -{ - return XHASH (key) ^ XTYPE (key); -} - /* Value is a hash code for KEY for use in hash table H which uses `equal' to compare keys. The hash code returned is guaranteed to fit= in a Lisp integer. */ @@ -3809,7 +3743,7 @@ hashfn_equal (struct hash_table_test *ht, Lisp_Obje= ct key) static EMACS_UINT hashfn_eql (struct hash_table_test *ht, Lisp_Object key) { - return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key); + return FLOATP (key) ? hashfn_equal (ht, key) : XHASH (key) ^ XTYPE (ke= y); } =20 /* Value is a hash code for KEY for use in hash table H which uses as @@ -3820,14 +3754,14 @@ static EMACS_UINT hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key) { Lisp_Object hash =3D call1 (ht->user_hash_function, key); - return hashfn_eq (ht, hash); + return hashfn_eql (ht, hash); } =20 struct hash_table_test const hashtest_eq =3D { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), 0, hashfn_eq }, + LISPSYM_INITIALLY (Qnil), 0, hashfn_eql }, hashtest_eql =3D { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil),= - LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql }, + LISPSYM_INITIALLY (Qnil), 0, hashfn_eql }, hashtest_equal =3D { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qn= il), LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal }; =20 @@ -4063,7 +3997,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object= key, EMACS_UINT *hash) start_of_bucket =3D hash_code % ASIZE (h->index); =20 for (i =3D HASH_INDEX (h, start_of_bucket); 0 <=3D i; i =3D HASH_NEXT = (h, i)) - if (EQ (key, HASH_KEY (h, i)) + if (EQL (key, HASH_KEY (h, i)) || (h->test.cmpfn && hash_code =3D=3D XUINT (HASH_HASH (h, i)) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) @@ -4120,7 +4054,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, = Lisp_Object key) 0 <=3D i; i =3D HASH_NEXT (h, i)) { - if (EQ (key, HASH_KEY (h, i)) + if (EQL (key, HASH_KEY (h, i)) || (h->test.cmpfn && hash_code =3D=3D XUINT (HASH_HASH (h, i)) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) @@ -4360,9 +4294,10 @@ sxhash_string (char const *ptr, ptrdiff_t len) =20 /* Return a hash for the floating point value VAL. */ =20 -static EMACS_UINT -sxhash_float (double val) +EMACS_UINT +sxhash_float (Lisp_Object obj) { + double val =3D XFLOAT_DATA (obj); EMACS_UINT hash =3D 0; union double_and_words u =3D { .val =3D val }; for (int i =3D 0; i < WORDS_PER_DOUBLE; i++) @@ -4481,7 +4416,7 @@ sxhash (Lisp_Object obj, int depth) break; =20 case Lisp_Float: - hash =3D sxhash_float (XFLOAT_DATA (obj)); + hash =3D sxhash_float (obj); break; =20 default: @@ -4501,14 +4436,6 @@ DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, = 0, doc: /* Return an integer hash code for OBJ suitable for `eq'. If (eq A B), then (=3D (sxhash-eq A) (sxhash-eq B)). */) (Lisp_Object obj) -{ - return make_number (hashfn_eq (NULL, obj)); -} - -DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, - doc: /* Return an integer hash code for OBJ suitable for `eql'. -If (eql A B), then (=3D (sxhash-eql A) (sxhash-eql B)). */) - (Lisp_Object obj) { return make_number (hashfn_eql (NULL, obj)); } @@ -4574,9 +4501,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:test TEST' among the arguments. */ i =3D get_key_arg (QCtest, nargs, args, used); test =3D i ? args[i] : Qeql; - if (EQ (test, Qeq)) - testdesc =3D hashtest_eq; - else if (EQ (test, Qeql)) + if (EQ (test, Qeq) || EQ (test, Qeql)) testdesc =3D hashtest_eql; else if (EQ (test, Qequal)) testdesc =3D hashtest_equal; @@ -5226,7 +5151,6 @@ syms_of_fns (void) DEFSYM (Qkey_and_value, "key-and-value"); =20 defsubr (&Ssxhash_eq); - defsubr (&Ssxhash_eql); defsubr (&Ssxhash_equal); defsubr (&Smake_hash_table); defsubr (&Scopy_hash_table); @@ -5344,7 +5268,6 @@ this variable. */); defsubr (&Selt); defsubr (&Smember); defsubr (&Smemq); - defsubr (&Smemql); defsubr (&Sassq); defsubr (&Sassoc); defsubr (&Srassq); diff --git a/src/lisp.h b/src/lisp.h index 96de60e467..62996b7ee5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -377,7 +377,7 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr #define lisp_h_XCONS(a) \ (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) -#define lisp_h_XHASH(a) XUINT (a) +#define lisp_h_XHASH(a) (FLOATP (a) ? sxhash_float (a) : XUINT (a)) #ifndef GC_CHECK_CONS_LIST # define lisp_h_check_cons_list() ((void) 0) #endif @@ -615,6 +615,8 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = =3D false }; /* Forward declarations. */ =20 /* Defined in this file. */ +INLINE bool FLOATP (Lisp_Object); +INLINE double XFLOAT_DATA (Lisp_Object); INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); =20 @@ -625,6 +627,8 @@ extern void char_table_set (Lisp_Object, int, Lisp_Ob= ject); /* Defined in data.c. */ extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object); =20 +/* Defined in fns.c. */ +EMACS_UINT sxhash_float (Lisp_Object); =20 #ifdef CANNOT_DUMP enum { might_dump =3D false }; @@ -1125,7 +1129,13 @@ make_natnum (EMACS_INT n) return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS)); } =20 -/* Return true if X and Y are the same object. */ +/* Return true if X and Y are the same object. Unlike EQL, this + distinguishes floats with the same values but different addresses. + The C name EQ is a misnomer, and dates back to when Lisp eq behaved + like C EQ does now. Nowadays Lisp eq is equivalent to the Lisp eql + and the C EQL. C EQ is meant for low-level C code, e.g., for + efficiency in places where at least one argument is a + non-float. */ =20 INLINE bool (EQ) (Lisp_Object x, Lisp_Object y) @@ -1133,6 +1143,35 @@ INLINE bool return lisp_h_EQ (x, y); } =20 +enum { WORDS_PER_DOUBLE =3D (sizeof (double) / sizeof (EMACS_UINT) + + (sizeof (double) % sizeof (EMACS_UINT) !=3D 0)) }; +union double_and_words +{ + double val; + EMACS_UINT word[WORDS_PER_DOUBLE]; +}; + +/* Return true if X and Y are the same floating-point value. + This looks at X's and Y's representation, since (unlike '=3D=3D') + it returns true if X and Y are the same NaN. */ +INLINE bool +same_float (Lisp_Object x, Lisp_Object y) +{ + union double_and_words + xu =3D { .val =3D XFLOAT_DATA (x) }, + yu =3D { .val =3D XFLOAT_DATA (y) }; + EMACS_UINT neql =3D 0; + for (int i =3D 0; i < WORDS_PER_DOUBLE; i++) + neql |=3D xu.word[i] ^ yu.word[i]; + return !neql; +} + +INLINE bool +EQL (Lisp_Object x, Lisp_Object y) +{ + return FLOATP (x) ? FLOATP (y) && same_float (x, y) : EQ (x, y); +} + /* True if the possibly-unsigned integer I doesn't fit in a Lisp fixnum.= */ =20 #define FIXNUM_OVERFLOW_P(i) \ diff --git a/src/textprop.c b/src/textprop.c index fe5b61e2dd..8ff2d625cc 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -237,11 +237,11 @@ interval_has_all_properties (Lisp_Object plist, INT= ERVAL i) =20 /* Go through I's plist, looking for sym1 */ for (tail2 =3D i->plist; CONSP (tail2); tail2 =3D Fcdr (XCDR (tail= 2))) - if (EQ (sym1, XCAR (tail2))) + if (EQL (sym1, XCAR (tail2))) { /* Found the same property on both lists. If the values are unequal, return false. */ - if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2)))) + if (! EQL (Fcar (XCDR (tail1)), Fcar (XCDR (tail2)))) return false; =20 /* Property has same value on both lists; go to next one. */ @@ -271,7 +271,7 @@ interval_has_some_properties (Lisp_Object plist, INTE= RVAL i) =20 /* Go through i's plist, looking for tail1 */ for (tail2 =3D i->plist; CONSP (tail2); tail2 =3D Fcdr (XCDR (tail= 2))) - if (EQ (sym, XCAR (tail2))) + if (EQL (sym, XCAR (tail2))) return true; } =20 @@ -293,7 +293,7 @@ interval_has_some_properties_list (Lisp_Object list, = INTERVAL i) =20 /* Go through i's plist, looking for tail1 */ for (tail2 =3D i->plist; CONSP (tail2); tail2 =3D XCDR (XCDR (tail= 2))) - if (EQ (sym, XCAR (tail2))) + if (EQL (sym, XCAR (tail2))) return true; } =20 @@ -310,7 +310,7 @@ property_value (Lisp_Object plist, Lisp_Object prop) Lisp_Object value; =20 while (PLIST_ELT_P (plist, value)) - if (EQ (XCAR (plist), prop)) + if (EQL (XCAR (plist), prop)) return XCAR (value); else plist =3D XCDR (value); @@ -334,8 +334,8 @@ set_properties (Lisp_Object properties, INTERVAL inte= rval, Lisp_Object object) for (sym =3D interval->plist; PLIST_ELT_P (sym, value); sym =3D XCDR (value)) - if (! EQ (property_value (properties, XCAR (sym)), - XCAR (value))) + if (! EQL (property_value (properties, XCAR (sym)), + XCAR (value))) { record_property_change (interval->position, LENGTH (interval), XCAR (sym), XCAR (value), @@ -388,7 +388,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_O= bject object, =20 /* Go through I's plist, looking for sym1 */ for (tail2 =3D i->plist; CONSP (tail2); tail2 =3D Fcdr (XCDR (tail= 2))) - if (EQ (sym1, XCAR (tail2))) + if (EQL (sym1, XCAR (tail2))) { Lisp_Object this_cdr; =20 @@ -398,7 +398,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_O= bject object, =20 /* The properties have the same value on both lists. Continue to the next property. */ - if (EQ (val1, Fcar (this_cdr))) + if (EQL (val1, Fcar (this_cdr))) break; =20 /* Record this change in the buffer, for undo purposes. */ @@ -473,7 +473,7 @@ remove_properties (Lisp_Object plist, Lisp_Object lis= t, INTERVAL i, Lisp_Object Lisp_Object sym =3D XCAR (tail1); =20 /* First, remove the symbol if it's at the head of the list */ - while (CONSP (current_plist) && EQ (sym, XCAR (current_plist))) + while (CONSP (current_plist) && EQL (sym, XCAR (current_plist))) { if (BUFFERP (object)) record_property_change (i->position, LENGTH (i), @@ -489,7 +489,7 @@ remove_properties (Lisp_Object plist, Lisp_Object lis= t, INTERVAL i, Lisp_Object while (! NILP (tail2)) { Lisp_Object this =3D XCDR (XCDR (tail2)); - if (CONSP (this) && EQ (sym, XCAR (this))) + if (CONSP (this) && EQL (sym, XCAR (this))) { if (BUFFERP (object)) record_property_change (i->position, LENGTH (i), @@ -822,7 +822,7 @@ last valid position in OBJECT. */) } =20 value =3D Fget_char_property (position, prop, object); - if (!EQ (value, initial_value)) + if (!EQL (value, initial_value)) break; } =20 @@ -914,7 +914,7 @@ first valid position in OBJECT. */) =3D Fget_char_property (make_number (XFASTINT (position) - 1), prop, object); =20 - if (!EQ (value, initial_value)) + if (!EQL (value, initial_value)) break; } } @@ -1024,7 +1024,7 @@ past position LIMIT; return LIMIT if nothing is fou= nd before LIMIT. */) here_val =3D textget (i->plist, prop); next =3D next_interval (i); while (next - && EQ (here_val, textget (next->plist, prop)) + && EQL (here_val, textget (next->plist, prop)) && (NILP (limit) || next->position < XFASTINT (limit))) next =3D next_interval (next); =20 @@ -1126,7 +1126,7 @@ back past position LIMIT; return LIMIT if nothing i= s found until LIMIT. */) here_val =3D textget (i->plist, prop); previous =3D previous_interval (i); while (previous - && EQ (here_val, textget (previous->plist, prop)) + && EQL (here_val, textget (previous->plist, prop)) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous =3D previous_interval (previous); @@ -1752,7 +1752,7 @@ markers). If OBJECT is a string, START and END are= 0-based indices into it. */ { if (i->position >=3D e) break; - if (EQ (textget (i->plist, property), value)) + if (EQL (textget (i->plist, property), value)) { pos =3D i->position; if (pos < XINT (start)) @@ -1789,7 +1789,7 @@ markers). If OBJECT is a string, START and END are= 0-based indices into it. */ { if (i->position >=3D e) break; - if (! EQ (textget (i->plist, property), value)) + if (! EQL (textget (i->plist, property), value)) { if (i->position > s) s =3D i->position; @@ -1922,7 +1922,7 @@ copy_text_properties (Lisp_Object start, Lisp_Objec= t end, Lisp_Object src, if (! NILP (prop)) while (! NILP (plist)) { - if (EQ (Fcar (plist), prop)) + if (EQL (Fcar (plist), prop)) { plist =3D list2 (prop, Fcar (Fcdr (plist))); break; @@ -1992,7 +1992,7 @@ text_property_list (Lisp_Object object, Lisp_Object= start, Lisp_Object end, Lisp =20 if (!NILP (prop)) for (; CONSP (plist); plist =3D Fcdr (XCDR (plist))) - if (EQ (XCAR (plist), prop)) + if (EQL (XCAR (plist), prop)) { plist =3D list2 (prop, Fcar (XCDR (plist))); break; diff --git a/src/window.c b/src/window.c index 422b06a49f..a220e61af8 100644 --- a/src/window.c +++ b/src/window.c @@ -4888,13 +4888,14 @@ window_wants_mode_line (struct window *w) { Lisp_Object window_mode_line_format =3D window_parameter (w, Qmode_line_format); + Lisp_Object buf =3D WINDOW_BUFFER (w); =20 - return ((WINDOW_LEAF_P (w) + return ((!NILP (buf) && !MINI_WINDOW_P (w) && !WINDOW_PSEUDO_P (w) && !EQ (window_mode_line_format, Qnone) && (!NILP (window_mode_line_format) - || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format)))= + || !NILP (BVAR (XBUFFER (buf), mode_line_format))) && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w)) ? 1 : 0); @@ -4919,13 +4920,14 @@ window_wants_header_line (struct window *w) { Lisp_Object window_header_line_format =3D window_parameter (w, Qheader_line_format); + Lisp_Object buf =3D WINDOW_BUFFER (w); =20 - return ((WINDOW_LEAF_P (w) + return ((!NILP (buf) && !MINI_WINDOW_P (w) && !WINDOW_PSEUDO_P (w) && !EQ (window_header_line_format, Qnone) && (!NILP (window_header_line_format) - || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format)= )) + || !NILP (BVAR (XBUFFER (buf), header_line_format))) && (WINDOW_PIXEL_HEIGHT (w) > (window_wants_mode_line (w) ? 2 * WINDOW_FRAME_LINE_HEIGHT (w) --=20 2.17.1 --------------F38975F16104A1503108D086--