[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 0eee48a 1/3: Introduce `sxhash-equal-including-prope
From: |
Andrea Corallo |
Subject: |
feature/native-comp 0eee48a 1/3: Introduce `sxhash-equal-including-properties'. |
Date: |
Wed, 21 Apr 2021 11:41:18 -0400 (EDT) |
branch: feature/native-comp
commit 0eee48af9de308ef57a065ecd8b2c2c7b59012a0
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Introduce `sxhash-equal-including-properties'.
* src/fns.c (collect_interval): Move it upwards.
(Fsxhash_equal_including_properties): New function.
(syms_of_fns): Register `sxhash-equal-including-properties'.
* etc/NEWS: Add 'sxhash-equal-including-properties'.
---
etc/NEWS | 5 +++++
src/fns.c | 43 ++++++++++++++++++++++++++++++++++---------
2 files changed, 39 insertions(+), 9 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index fb0ec90..6928cbc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2580,6 +2580,11 @@ the Emacs Lisp reference manual for background.
* Lisp Changes in Emacs 28.1
+++
+** New function 'sxhash-equal-including-properties'.
+This is identical to 'sxhash-equal' but accounting also for string
+properties.
+
++++
** 'unlock-buffer' displays warnings instead of signaling.
Instead of signaling 'file-error' conditions for file system level
errors, the function now calls 'display-warning' and continues as if
diff --git a/src/fns.c b/src/fns.c
index 1758148..41429c8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4492,6 +4492,15 @@ check_mutable_hash_table (Lisp_Object obj, struct
Lisp_Hash_Table *h)
eassert (!PURE_P (h));
}
+static void
+collect_interval (INTERVAL interval, Lisp_Object collector)
+{
+ nconc2 (collector,
+ list1(list3 (make_fixnum (interval->position),
+ make_fixnum (interval->position + LENGTH (interval)),
+ interval->plist)));
+}
+
/* Put an entry into hash table H that associates KEY with VALUE.
HASH is a previously computed hash code of KEY.
Value is the index of the entry in H matching KEY. */
@@ -4949,6 +4958,30 @@ Hash codes are not guaranteed to be preserved across
Emacs sessions. */)
return hashfn_equal (obj, NULL);
}
+DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties,
+ Ssxhash_equal_including_properties, 1, 1, 0,
+ doc: /* Return an integer hash code for OBJ suitable for
+`equal-including-properties'.
+If (sxhash-equal-including-properties A B), then
+(= (sxhash-equal-including-properties A) (sxhash-equal-including-properties
B)).
+
+Hash codes are not guaranteed to be preserved across Emacs sessions. */)
+ (Lisp_Object obj)
+{
+ if (STRINGP (obj))
+ {
+ Lisp_Object collector = Fcons (Qnil, Qnil);
+ traverse_intervals (string_intervals (obj), 0, collect_interval,
+ collector);
+ return
+ make_ufixnum (
+ SXHASH_REDUCE (sxhash_combine (sxhash (obj),
+ sxhash (CDR (collector)))));
+ }
+
+ return hashfn_equal (obj, NULL);
+}
+
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
doc: /* Create and return a new hash table.
@@ -5832,15 +5865,6 @@ Case is always significant and text properties are
ignored. */)
return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
}
-static void
-collect_interval (INTERVAL interval, Lisp_Object collector)
-{
- nconc2 (collector,
- list1(list3 (make_fixnum (interval->position),
- make_fixnum (interval->position + LENGTH (interval)),
- interval->plist)));
-}
-
DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0,
doc: /* Return a copy of the text properties of OBJECT.
OBJECT must be a buffer or a string.
@@ -5922,6 +5946,7 @@ syms_of_fns (void)
defsubr (&Ssxhash_eq);
defsubr (&Ssxhash_eql);
defsubr (&Ssxhash_equal);
+ defsubr (&Ssxhash_equal_including_properties);
defsubr (&Smake_hash_table);
defsubr (&Scopy_hash_table);
defsubr (&Shash_table_count);