Faster `string-lessp` for unibyte arguments

Since this function is commonly used as a sorting predicate
where it is time-critical, this is a useful optimisation.

* src/fns.c (Fstring_lessp): Add fast path for the common case
when both arguments are unibyte.
* test/src/fns-tests.el (fns-tests--string-lessp-cases)
(fns-tests-string-lessp): New test.

diff --git a/src/fns.c b/src/fns.c
index 8ec23c4e3a899170141b7e63e963affed940aaaf..ee4e80b5069ba5a0f39218a072051b6bf4a1172d 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -441,15 +441,24 @@ Symbols are also allowed; their print names are used instead.  */)
 {
   if (SYMBOLP (string1))
     string1 = SYMBOL_NAME (string1);
+  else
+    CHECK_STRING (string1);
   if (SYMBOLP (string2))
     string2 = SYMBOL_NAME (string2);
-  CHECK_STRING (string1);
-  CHECK_STRING (string2);
+  else
+    CHECK_STRING (string2);
+
+  ptrdiff_t n = min (SCHARS (string1), SCHARS (string2));
+  if (!STRING_MULTIBYTE (string1) && !STRING_MULTIBYTE (string2))
+    {
+      /* Both arguments are unibyte (hot path).  */
+      int d = memcmp (SSDATA (string1), SSDATA (string2), n);
+      return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil;
+    }
 
   ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
-  ptrdiff_t end = min (SCHARS (string1), SCHARS (string2));
 
-  while (i1 < end)
+  while (i1 < n)
     {
       /* When we find a mismatch, we must compare the
         characters, not just the bytes.  */

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 5b252e184f0cf030a4a04b6adf5b9266afcb9ee2..c080c4839274cf3edbdada881326850d3a872141 100644 (file)
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -130,6 +130,49 @@
     (should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
     (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
 
+(defconst fns-tests--string-lessp-cases
+  '((a 97 error)
+    (97 "a" error)
+    ("abc" "abd" t)
+    ("abd" "abc" nil)
+    (abc "abd" t)
+    ("abd" abc nil)
+    (abc abd t)
+    (abd abc nil)
+    ("" "" nil)
+    ("" " " t)
+    (" " "" nil)
+    ("abc" "abcd" t)
+    ("abcd" "abc" nil)
+    ("abc" "abc" nil)
+    (abc abc nil)
+    ("\0" "" nil)
+    ("" "\0" t)
+    ("~" "\x80" t)
+    ("\x80" "\x80" nil)
+    ("\xfe" "\xff" t)
+    ("Munchen" "München" t)
+    ("München" "Munchen" nil)
+    ("München" "München" nil)
+    ("Ré" "Réunion" t)))
+
+
+(ert-deftest fns-tests-string-lessp ()
+  ;; Exercise both `string-lessp' and its alias `string<', both directly
+  ;; and in a function (exercising its bytecode).
+  (dolist (lessp (list #'string-lessp #'string<
+                       (lambda (a b) (string-lessp a b))
+                       (lambda (a b) (string< a b))))
+    (ert-info ((prin1-to-string lessp) :prefix "function: ")
+      (dolist (case fns-tests--string-lessp-cases)
+        (ert-info ((prin1-to-string case) :prefix "case: ")
+          (pcase case
+            (`(,x ,y error)
+             (should-error (funcall lessp x y)))
+            (`(,x ,y ,expected)
+             (should (equal (funcall lessp x y) expected)))))))))
+
+
 (ert-deftest fns-tests-compare-strings ()
   (should-error (compare-strings))
   (should-error (compare-strings "xyzzy" "xyzzy"))