From 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)) +(defalias 'memql 'memq) +(defalias 'sxhash-eql 'sxhash-eq) + (defun member-ignore-case (elt list) "Like `member', but ignore differences in case and text representation. 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 vector, Lisp_Object maxdepth, CASE (Beq): { Lisp_Object v1 = POP; - TOP = EQ (v1, TOP) ? Qt : Qnil; + TOP = EQL (v1, TOP) ? Qt : Qnil; NEXT; } @@ -1418,7 +1418,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ? make_number (h->test.hashfn (&h->test, v1)) : Qnil; for (i = h->count; 0 <= --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; - 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 = Vword_separating_categories; default_result = 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 = defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *from = 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 = defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *to = c - 1; break; @@ -356,7 +356,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) else if (NILP (this_val)) this_val = tbl->defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *from = c + 1; break; @@ -376,7 +376,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) tbl->defalt, is_uniprop); else if (NILP (this_val)) this_val = tbl->defalt; - if (! EQ (this_val, val)) + if (! EQL (this_val, val)) { *to = c - 1; break; @@ -684,7 +684,7 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Object 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 = 0; } @@ -791,7 +791,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), { if (NILP (this)) this = XCHAR_TABLE (top)->defalt; - if (!EQ (val, this)) + if (!EQL (val, this)) { bool different_value = 1; @@ -811,7 +811,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), val = map_sub_char_table (c_function, function, parent, arg, val, range, parent); - if (EQ (val, this)) + if (EQL (val, this)) different_value = 0; } } @@ -1223,7 +1223,7 @@ uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value) int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]); for (i = 0; i < size; i++) - if (EQ (value, value_table[i])) + if (EQL (value, value_table[i])) break; if (i == size) wrong_type_argument (build_string ("Unicode property value"), value); @@ -1242,7 +1242,7 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value) CHECK_NUMBER (value); for (i = 0; i < size; i++) - if (EQ (value, value_table[i])) + if (EQL (value, value_table[i])) break; value = make_number (i); if (i == 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 newval, 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_Object 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 == 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 == 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)); } 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_alias), CALLN (Fformat_message, @@ -1067,7 +1067,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) } { Lisp_Object newform = apply1 (expander, XCDR (form)); - if (EQ (form, newform)) + if (EQL (form, newform)) break; else form = newform; @@ -1186,7 +1186,7 @@ Both TAG and VALUE are evalled. */ { if (c->type == CATCHER_ALL) unwind_to_catch (c, Fcons (tag, value)); - if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) + if (c->type == 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 = 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); } -enum { WORDS_PER_DOUBLE = (sizeof (double) / sizeof (EMACS_UINT) - + (sizeof (double) % sizeof (EMACS_UINT) != 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 '==') - 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 = { .val = XFLOAT_DATA (x) }, - yu = { .val = XFLOAT_DATA (y) }; - EMACS_UINT neql = 0; - for (int i = 0; i < WORDS_PER_DOUBLE; i++) - neql |= 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 = list; FOR_EACH_TAIL (tail) - if (EQ (XCAR (tail), elt)) + if (EQL (XCAR (tail), elt)) return tail; CHECK_LIST_END (tail, list); return Qnil; } -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 = list; - FOR_EACH_TAIL (tail) - { - Lisp_Object tem = 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 = 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; } -/* 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. */ Lisp_Object assq_no_quit (Lisp_Object key, Lisp_Object list) { + eassert (!FLOATP (key)); for (; ! NILP (list); list = 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 whose cdr is KEY. */) { Lisp_Object tail = 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 = XCAR (tail); - if (EQ (elt, tem)) + if (EQL (elt, tem)) { if (NILP (prev)) list = XCDR (tail); @@ -2084,7 +2044,7 @@ properties on the list. This function never signals an error. */) { if (! CONSP (XCDR (tail))) break; - if (EQ (prop, XCAR (tail))) + if (EQL (prop, XCAR (tail))) return XCAR (XCDR (tail)); tail = XCDR (tail); if (EQ (tail, li.tortoise)) @@ -2123,7 +2083,7 @@ The PLIST is modified by side effects. */) if (! CONSP (XCDR (tail))) break; - 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 `=' 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; } DEFUN ("equal", Fequal, Sequal, 2, 2, 0, @@ -2959,7 +2916,7 @@ The value is actually the tail of PLIST whose car is PROP. */) Lisp_Object tail = plist; FOR_EACH_TAIL (tail) { - if (EQ (XCAR (tail), prop)) + if (EQL (XCAR (tail), prop)) return tail; tail = XCDR (tail); if (! CONSP (tail)) @@ -3747,18 +3704,6 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) return XINT (AREF (h->index, idx)); } -/* 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. */ @@ -3770,7 +3715,6 @@ cmpfn_equal (struct hash_table_test *ht, return !NILP (Fequal (key1, key2)); } - /* Compare KEY1 and KEY2 in hash table HT using HT->user_cmp_function. Value is true if KEY1 and KEY2 are the same. */ @@ -3782,16 +3726,6 @@ cmpfn_user_defined (struct hash_table_test *ht, return !NILP (call2 (ht->user_cmp_function, key1, key2)); } -/* 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_Object 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 (key); } /* 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 = call1 (ht->user_hash_function, key); - return hashfn_eq (ht, hash); + return hashfn_eql (ht, hash); } struct hash_table_test const hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), 0, hashfn_eq }, + LISPSYM_INITIALLY (Qnil), 0, hashfn_eql }, hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql }, + LISPSYM_INITIALLY (Qnil), 0, hashfn_eql }, hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil), LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal }; @@ -4063,7 +3997,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) start_of_bucket = hash_code % ASIZE (h->index); for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) - if (EQ (key, HASH_KEY (h, i)) + if (EQL (key, HASH_KEY (h, i)) || (h->test.cmpfn && hash_code == 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 <= i; i = HASH_NEXT (h, i)) { - if (EQ (key, HASH_KEY (h, i)) + if (EQL (key, HASH_KEY (h, i)) || (h->test.cmpfn && hash_code == 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) /* Return a hash for the floating point value VAL. */ -static EMACS_UINT -sxhash_float (double val) +EMACS_UINT +sxhash_float (Lisp_Object obj) { + double val = XFLOAT_DATA (obj); EMACS_UINT hash = 0; union double_and_words u = { .val = val }; for (int i = 0; i < WORDS_PER_DOUBLE; i++) @@ -4481,7 +4416,7 @@ sxhash (Lisp_Object obj, int depth) break; case Lisp_Float: - hash = sxhash_float (XFLOAT_DATA (obj)); + hash = sxhash_float (obj); break; 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 (= (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 (= (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 = get_key_arg (QCtest, nargs, args, used); test = i ? args[i] : Qeql; - if (EQ (test, Qeq)) - testdesc = hashtest_eq; - else if (EQ (test, Qeql)) + if (EQ (test, Qeq) || EQ (test, Qeql)) testdesc = hashtest_eql; else if (EQ (test, Qequal)) testdesc = hashtest_equal; @@ -5226,7 +5151,6 @@ syms_of_fns (void) DEFSYM (Qkey_and_value, "key-and-value"); 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 = false }; /* Forward declarations. */ /* 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); @@ -625,6 +627,8 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object); +/* Defined in fns.c. */ +EMACS_UINT sxhash_float (Lisp_Object); #ifdef CANNOT_DUMP enum { might_dump = false }; @@ -1125,7 +1129,13 @@ make_natnum (EMACS_INT n) return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS)); } -/* 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. */ INLINE bool (EQ) (Lisp_Object x, Lisp_Object y) @@ -1133,6 +1143,35 @@ INLINE bool return lisp_h_EQ (x, y); } +enum { WORDS_PER_DOUBLE = (sizeof (double) / sizeof (EMACS_UINT) + + (sizeof (double) % sizeof (EMACS_UINT) != 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 '==') + 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 = { .val = XFLOAT_DATA (x) }, + yu = { .val = XFLOAT_DATA (y) }; + EMACS_UINT neql = 0; + for (int i = 0; i < WORDS_PER_DOUBLE; i++) + neql |= 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. */ #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, INTERVAL i) /* Go through I's plist, looking for sym1 */ for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) - 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; /* Property has same value on both lists; go to next one. */ @@ -271,7 +271,7 @@ interval_has_some_properties (Lisp_Object plist, INTERVAL i) /* Go through i's plist, looking for tail1 */ for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) - if (EQ (sym, XCAR (tail2))) + if (EQL (sym, XCAR (tail2))) return true; } @@ -293,7 +293,7 @@ interval_has_some_properties_list (Lisp_Object list, INTERVAL i) /* Go through i's plist, looking for tail1 */ for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2))) - if (EQ (sym, XCAR (tail2))) + if (EQL (sym, XCAR (tail2))) return true; } @@ -310,7 +310,7 @@ property_value (Lisp_Object plist, Lisp_Object prop) Lisp_Object value; while (PLIST_ELT_P (plist, value)) - if (EQ (XCAR (plist), prop)) + if (EQL (XCAR (plist), prop)) return XCAR (value); else plist = XCDR (value); @@ -334,8 +334,8 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object) for (sym = interval->plist; PLIST_ELT_P (sym, value); sym = 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_Object object, /* Go through I's plist, looking for sym1 */ for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2))) - if (EQ (sym1, XCAR (tail2))) + if (EQL (sym1, XCAR (tail2))) { Lisp_Object this_cdr; @@ -398,7 +398,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, /* 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; /* Record this change in the buffer, for undo purposes. */ @@ -473,7 +473,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object Lisp_Object sym = XCAR (tail1); /* 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 list, INTERVAL i, Lisp_Object while (! NILP (tail2)) { Lisp_Object this = 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. */) } value = Fget_char_property (position, prop, object); - if (!EQ (value, initial_value)) + if (!EQL (value, initial_value)) break; } @@ -914,7 +914,7 @@ first valid position in OBJECT. */) = Fget_char_property (make_number (XFASTINT (position) - 1), prop, object); - if (!EQ (value, initial_value)) + if (!EQL (value, initial_value)) break; } } @@ -1024,7 +1024,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) here_val = textget (i->plist, prop); next = 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 = next_interval (next); @@ -1126,7 +1126,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) here_val = textget (i->plist, prop); previous = 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 = 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 >= e) break; - if (EQ (textget (i->plist, property), value)) + if (EQL (textget (i->plist, property), value)) { pos = 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 >= e) break; - if (! EQ (textget (i->plist, property), value)) + if (! EQL (textget (i->plist, property), value)) { if (i->position > s) s = i->position; @@ -1922,7 +1922,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, if (! NILP (prop)) while (! NILP (plist)) { - if (EQ (Fcar (plist), prop)) + if (EQL (Fcar (plist), prop)) { plist = list2 (prop, Fcar (Fcdr (plist))); break; @@ -1992,7 +1992,7 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp if (!NILP (prop)) for (; CONSP (plist); plist = Fcdr (XCDR (plist))) - if (EQ (XCAR (plist), prop)) + if (EQL (XCAR (plist), prop)) { plist = 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 = window_parameter (w, Qmode_line_format); + Lisp_Object buf = WINDOW_BUFFER (w); - 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 = window_parameter (w, Qheader_line_format); + Lisp_Object buf = WINDOW_BUFFER (w); - 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) -- 2.17.1