Calc: speed up math-read-preprocess-string (bug#67536)

`math-read-preprocess-string` is one of the bottlenecks of `calc-eval`
and was unnecessarily slow even with no substitutions made.
This affected org-mode in particular, where `calc-eval` is called
repeatedly to recalculate tables.

Reported by Raffael Stocker who also wrote the unit tests here.

* lisp/calc/calc-aent.el (math--read-preprocess-re-cache): New.
(math-read-preprocess-string):
Use math--read-preprocess-re-cache, first computing it if necessary.
* test/lisp/calc/calc-tests.el (calc-math-read-preprocess-string):
New test.

lisp/calc/calc-aent.el

@@ -547,22 +547,41 @@ The value t means abort and give an error message.")
   "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 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))  ; not super/subscript
+       (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.

test/lisp/calc/calc-tests.el

@@ -816,5 +816,43 @@ An existing calc stack is reused, otherwise a new one is created."
          (x (calc-tests--calc-to-number (math-pow 8 '(frac 1 6)))))
     (should (< (abs (- x (sqrt 2.0))) 1.0e-10))))
 
+(require 'calc-aent)
+
+(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