feature/native-comp 0eee48a 1/3: Introduce `sxhash-equal-including-properties'.

[Andrea Corallo]

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);