Subject: Re: bug#67536: 29.1; Calc mode's math-read-preprocess-string conses unnecessarily

From: Raffael Stocker <[email-masked]>
Date: Mon, 18 Dec 2023 12:39:01 +0100

Mattias Engdegård <[email-masked]> writes:

> Of course my clumsy code didn't preserve the possibility for
> `math-read-replacement-list` to translate strings longer than a single
> character but that's what I get for sending off-cuff patches that way.

...and my test did not catch that edge case.  I extended the test with
this and an empty ‘math-read-replacement-list’ for good measure
(although I don't quite know which use case that might be).  The test
fails for the previous version and succeeds for the original and this
new one.

Have I missed any other edge cases in the test?

I appended the updated patch.

>From 66f63f993d87161cfeaf07366eb9dc68738b5891 Mon Sep 17 00:00:00 2001
From: Raffael Stocker <[email-masked]>
Date: Mon, 18 Dec 2023 12:35:33 +0100
Subject: [PATCH] * lisp/calc/calc-aent.el (math-read-preprocess-string):
 optimize (bug#67536)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is an optimized version of ‘math-read-preprocess-string’ by
Mattias Engdegård <[email-masked]>, with unit tests.

This function is called by calc-eval, which in turn is called
repeatedly when re-calculating org-mode tables.  It was one of the
main bottlenecks there and this optimization addresses this by not
repeatedly allocating new strings while iterating through the
replacement list, but instead working through the argument string only
once, using a "flattened" and cached regexp and only one call to
‘replace-regexp-in-string’.
---
 lisp/calc/calc-aent.el       | 45 +++++++++++++++++++++++++-----------
 test/lisp/calc/calc-tests.el | 37 +++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+), 13 deletions(-)

diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 66ede3295ae..ae04a850f5d 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -547,22 +547,41 @@ math-read-subscripts
   "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 0123456789+-()
   "A string consisting of the subscripts allowed by Calc.")
 
+(defvar math--read-preprocess-re-cache nil
+  "Cached regexp and tag: (REGEXP REPLACEMENTS SUPERSCRIPTS SUBSCRIPTS)")
+
 ;;;###autoload
 (defun math-read-preprocess-string (str)
   "Replace some substrings of STR by Calc equivalents."
-  (setq str
-        (replace-regexp-in-string (concat "[" math-read-superscripts "]+")
-                                  "^(\\&)" str))
-  (setq str
-        (replace-regexp-in-string (concat "[" math-read-subscripts "]+")
-                                  "_(\\&)" str))
-  (let ((rep-list math-read-replacement-list))
-    (while rep-list
-      (setq str
-            (replace-regexp-in-string (nth 0 (car rep-list))
-                                      (nth 1 (car rep-list)) str))
-      (setq rep-list (cdr rep-list))))
-  str)
+  (unless (and (eq (nth 1 math--read-preprocess-re-cache)
+                   math-read-replacement-list)
+               (eq (nth 2 math--read-preprocess-re-cache)
+                   math-read-superscripts)
+               (eq (nth 3 math--read-preprocess-re-cache)
+                   math-read-subscripts))
+    ;; Cache invalid, recompute.
+    (setq math--read-preprocess-re-cache
+          (list (rx-to-string
+                 `(or (or (+ (in ,math-read-superscripts))
+                          (group (+ (in ,math-read-subscripts))))
+                      (group (or ,@(mapcar #'car math-read-replacement-list))))
+                 t)
+                math-read-replacement-list
+                math-read-superscripts
+                math-read-subscripts)))
+  (replace-regexp-in-string
+   (nth 0 math--read-preprocess-re-cache)
+   (lambda (s)
+     (if (match-beginning 2)
+         (cadr (assoc s math-read-replacement-list))
+       (concat (if (match-beginning 1) "_" "^")
+               "("
+               (mapconcat (lambda (c)
+                            (cadr (assoc (char-to-string c)
+                                         math-read-replacement-list)))
+                          s)
+               ")")))
+   str t))
 
 ;; The next few variables are local to math-read-exprs (and math-read-expr
 ;; in calc-ext.el), but are set in functions they call.
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 5b11dd950ba..e49df216019 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -816,5 +816,42 @@ calc-nth-root
          (x (calc-tests--calc-to-number (math-pow 8 '(frac 1 6)))))
     (should (< (abs (- x (sqrt 2.0))) 1.0e-10))))
 
+(ert-deftest calc-math-read-preprocess-string ()
+  "Test replacement of allowed special Unicode symbols."
+  ;; ... doesn't change an empty string
+  (should (string= "" (math-read-preprocess-string "")))
+  ;; ... doesn't change a string without characters from
+  ;; ‘math-read-replacement-list’
+  (let ((str "don't replace here"))
+    (should (string= str (math-read-preprocess-string str))))
+  ;; ... replaces irrespective of position in input string
+  (should (string= "^(1)" (math-read-preprocess-string "¹")))
+  (should (string= "some^(1)" (math-read-preprocess-string "some¹")))
+  (should (string= "^(1)time" (math-read-preprocess-string "¹time")))
+  (should (string= "some^(1)else" (math-read-preprocess-string "some¹else")))
+  ;; ... replaces every element of ‘math-read-replacement-list’ correctly,
+  ;; in particular combining consecutive super-/subscripts into one
+  ;; exponent/subscript
+  (should (string= (concat "+/-*:-/*inf<=>=<=>=μ(1:4)(1:2)(3:4)(1:3)(2:3)"
+                           "(1:5)(2:5)(3:5)(4:5)(1:6)(5:6)"
+                           "(1:8)(3:8)(5:8)(7:8)1:^(0123456789+-()ni)"
+                           "_(0123456789+-())")
+                   (math-read-preprocess-string (mapconcat #'car
+                                                           math-read-replacement-list
+                                                           ""))))
+  ;; ... replaces strings of more than a single character correctly
+  (let ((math-read-replacement-list (append
+                                     math-read-replacement-list
+                                     '(("𝚤𝚥" "ij"))
+                                     '(("¼½" "(1:4)(1:2)")))))
+    (should (string= "(1:4)(1:2)ij"
+                     (math-read-preprocess-string "¼½𝚤𝚥"))))
+  ;; ... handles an empty replacement list gracefully
+  (let ((math-read-replacement-list '()))
+    (should (string= "¼" (math-read-preprocess-string "¼"))))
+  ;; ... signals an error if the argument is not a string
+  (should-error (math-read-preprocess-string nil))
+  (should-error (math-read-preprocess-string 42)))
+
 (provide 'calc-tests)
 ;;; calc-tests.el ends here
-- 
2.43.0