master 7c1c2519167 2/2: Calc: speed up math-read-preprocess-string (bug#67536)

[Mattias Engdegård]

branch: master
commit 7c1c2519167d51931a5d17f27529c8c8358c7c61
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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       | 45 +++++++++++++++++++++++++++++++-------------
 test/lisp/calc/calc-tests.el | 38 +++++++++++++++++++++++++++++++++++++
 2 files changed, 70 insertions(+), 13 deletions(-)

diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 66ede3295ae..2aafa653e5a 100644
--- a/lisp/calc/calc-aent.el
+++ b/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.
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 5b11dd950ba..74eaf9093e8 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/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