diff options
Diffstat (limited to 'src/fns.c')
| -rw-r--r-- | src/fns.c | 103 |
1 files changed, 67 insertions, 36 deletions
diff --git a/src/fns.c b/src/fns.c index 92a853e1755..38b2d281f07 100644 --- a/src/fns.c +++ b/src/fns.c @@ -144,6 +144,28 @@ which is at least the number of distinct elements. */) return make_fixnum_or_float (len); } +DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0, + doc: /* Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ + attributes: const) + (Lisp_Object object) +{ + intptr_t len = 0; + Lisp_Object last_tail = object; + Lisp_Object tail = object; + FOR_EACH_TAIL_SAFE (tail) + { + len++; + rarely_quit (len); + last_tail = XCDR (tail); + } + if (!NILP (last_tail)) + return Qnil; + if (MOST_POSITIVE_FIXNUM < len) + xsignal0 (Qoverflow_error); + return make_number (len); +} + DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, doc: /* Return the number of bytes in STRING. If STRING is multibyte, this may be greater than the length of STRING. */) @@ -718,7 +740,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, val = make_uninit_string (result_len); /* In `append', if all but last arg are nil, return last arg. */ - if (target_type == Lisp_Cons && EQ (val, Qnil)) + if (target_type == Lisp_Cons && NILP (val)) return last_tail; /* Copy the contents of the args into the result. */ @@ -1419,6 +1441,29 @@ 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. */) @@ -1457,7 +1502,7 @@ The value is actually the tail of LIST whose car is ELT. */) FOR_EACH_TAIL (tail) { Lisp_Object tem = XCAR (tail); - if (FLOATP (tem) && equal_no_quit (elt, tem)) + if (FLOATP (tem) && same_float (elt, tem)) return tail; } CHECK_LIST_END (tail, list); @@ -2170,11 +2215,15 @@ The PLIST is modified by side effects. */) } DEFUN ("eql", Feql, Seql, 2, 2, 0, - doc: /* Return t if the two args are the same Lisp object. -Floating-point numbers of equal value are `eql', but they may not be `eq'. */) + doc: /* Return t if the two args are `eq' or are indistinguishable numbers. +Floating-point values with the same sign, exponent and fraction are `eql'. +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) || BIGNUMP (obj1)) + if (FLOATP (obj1)) + return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil; + else if (BIGNUMP (obj1)) return equal_no_quit (obj1, obj2) ? Qt : Qnil; else return EQ (obj1, obj2) ? Qt : Qnil; @@ -2185,8 +2234,8 @@ DEFUN ("equal", Fequal, Sequal, 2, 2, 0, They must have the same data type. Conses are compared by comparing the cars and the cdrs. Vectors and strings are compared element by element. -Numbers are compared by value, but integers cannot equal floats. - (Use `=' if you want integers and floats to be able to be equal.) +Numbers are compared via `eql', so integers do not equal floats. +\(Use `=' if you want integers and floats to be able to be equal.) Symbols must match exactly. */) (Lisp_Object o1, Lisp_Object o2) { @@ -2266,13 +2315,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, switch (XTYPE (o1)) { case Lisp_Float: - { - double d1 = XFLOAT_DATA (o1); - double d2 = XFLOAT_DATA (o2); - /* If d is a NaN, then d != d. Two NaNs should be `equal' even - though they are not =. */ - return d1 == d2 || (d1 != d1 && d2 != d2); - } + return same_float (o1, o2); case Lisp_Cons: if (equal_kind == EQUAL_NO_QUIT) @@ -3708,9 +3751,8 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) return XFIXNUM (AREF (h->index, idx)); } -/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `eql'. Value is true if KEY1 and - KEY2 are the same. */ +/* 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, @@ -3719,7 +3761,7 @@ cmpfn_eql (struct hash_table_test *ht, { if (FLOATP (key1) && FLOATP (key2) - && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)) + && same_float (key1, key2)) return true; return (BIGNUMP (key1) && BIGNUMP (key2) @@ -3727,9 +3769,8 @@ cmpfn_eql (struct hash_table_test *ht, } -/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code - HASH2 in hash table H using `equal'. Value is true if KEY1 and - KEY2 are the same. */ +/* Compare KEY1 and KEY2 in hash table HT using `equal'. Value is + true if KEY1 and KEY2 are the same. */ static bool cmpfn_equal (struct hash_table_test *ht, @@ -3740,9 +3781,8 @@ cmpfn_equal (struct hash_table_test *ht, } -/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code - HASH2 in hash table H using H->user_cmp_function. Value is true - if KEY1 and KEY2 are the same. */ +/* Compare KEY1 and KEY2 in hash table HT using HT->user_cmp_function. + Value is true if KEY1 and KEY2 are the same. */ static bool cmpfn_user_defined (struct hash_table_test *ht, @@ -4336,18 +4376,8 @@ static EMACS_UINT sxhash_float (double val) { EMACS_UINT hash = 0; - enum { - WORDS_PER_DOUBLE = (sizeof val / sizeof hash - + (sizeof val % sizeof hash != 0)) - }; - union { - double val; - EMACS_UINT word[WORDS_PER_DOUBLE]; - } u; - int i; - u.val = val; - memset (&u.val + 1, 0, sizeof u - sizeof u.val); - for (i = 0; i < WORDS_PER_DOUBLE; i++) + union double_and_words u = { .val = val }; + for (int i = 0; i < WORDS_PER_DOUBLE; i++) hash = sxhash_combine (hash, u.word[i]); return SXHASH_REDUCE (hash); } @@ -5319,6 +5349,7 @@ this variable. */); defsubr (&Srandom); defsubr (&Slength); defsubr (&Ssafe_length); + defsubr (&Sproper_list_p); defsubr (&Sstring_bytes); defsubr (&Sstring_distance); defsubr (&Sstring_equal); |