Subject: bug#47711: bug#48841: bug#47711: bug#48841: bug#47711: [PATCH VERSION 2] Add new `completion-filter-completions` API and deferred highlighting

From: João Távora <[email-masked]>
Date: Wed, 25 Oct 2023 18:52:26 +0100

Dmitry Gutov <[email-masked]> writes:

> Hi all!
> Time flies, doesn't it?

Indeed.  First, thanks for working on this.  I tried your patches and
could reproduce all your numbers with a recent master (643c67cf239).

After checking the 2021 version again (254dc6ab4) I've discovered that
2023 Emacs doesn't respond as well to the lazy-hilit patch as 2021
Emacs.  It's as if the cost of string copies (that the patch optimized)
has gone down significantly.  In addition, in 2021, we never had anyone
perform the needed changes for icomplete.el to work with Daniel's API.
It was only known that without those changes, icomplete.el actually
performed worse under the new patch

So, backed by the new ability to conduct good benchmarks, I looked at
the problem anew. I found some insight in the problem, and came up with
a new "lazy-hilit" patch which performs just as well, if not slightly
better, than Daniel's, while keeping the changes to lisp/minibuffer.el
much more minimal and not adding replacement for the longstanding
completion-all-completions.

Before I go into benchmarks, it's obvious to me that "lazy" or
"deferred" highlighting mean basically the same thing, which is "late"
or "just-in-time" highlighting.

I also think, as I did in 2021, that we should be careful to separate
what are performance-motivated changes from style-motivated changes.
The former are easy to discuss objectively, while the latter are much,
much more subjective.

Whatever the outcome, we're on our way to at least a faster
icomplete.el, which is of course good.

So here are the benchmarks.  The setup is the following, we start Emacs
like:

   src/emacs -nw -Q -f fido-vertical-mode -l ~/Downloads/benchmark.el

And make sure to put 300 000 symbols in the obarray.  The symbols are
prefixed "yoyo" deliberately.

    (cl-loop repeat 300000 do (intern (symbol-name (gensym "yoyo"))))

First a micro-benchmark:

   ;; Daniel's patch worked by Dmitry (v3)
   (benchmark-run 50
    (let ((completion-styles '(flex)))
      (completion-filter-completions "" obarray 'fboundp 0 nil)
      (completion-filter-completions "yo" obarray 'fboundp 0 nil)
      (completion-filter-completions "yoo" obarray 'fboundp 0 nil)
      ));; => (12.192422429999999 3 0.107881004)

  ;; lazy-hilit v4 patch attached in this email
  (benchmark-run 50
    (let ((completion-styles '(flex))
          (completion-lazy-hilit (cl-gensym)))
      (completion-all-completions "" obarray 'fboundp 0 nil)
      (completion-all-completions "yo" obarray 'fboundp 0 nil)
      (completion-all-completions "yoo" obarray 'fboundp 0 nil)
      ));; => (12.267915333 4 0.14799709099999991)

Now, tests specific to icomplete.el using Dmitry's instrumentation.
This is the "yoyo" test.  Evaluate:

   (completing-read "" obarray)

This starts a fido-vertical-mode minibuffer.  First type "yo", then
repeatedly insert and backspace a "o" to make "yoo" and "yo" in
alternating fashion.

The number of matches should be exactly 300696 for "yoo" and 301721 for
"yo".  Highlighting should be correct, of course.

Observe the results printed by the instrumentation in `icomplete.el`.
Collect them from *Messages* after 18 alternations.

The results:

  ;; with Daniel's patch to minibuffer
  ;; 
  ;; Elapsed time: 0.967481s (0.401923s in 8 GCs)
  ;; Elapsed time: 0.703229s (0.252157s in 5 GCs)
  ;; Elapsed time: 0.945053s (0.401540s in 8 GCs)
  ;; Elapsed time: 0.721198s (0.252657s in 5 GCs)
  ;; Elapsed time: 0.951377s (0.394238s in 8 GCs)
  ;; Elapsed time: 0.699232s (0.254524s in 5 GCs)
  ;; Elapsed time: 0.940497s (0.400292s in 8 GCs)
  ;; Elapsed time: 0.709986s (0.253635s in 5 GCs)
  ;; Elapsed time: 0.943063s (0.399020s in 8 GCs)
  ;; Elapsed time: 0.720825s (0.251619s in 5 GCs)
  ;; Elapsed time: 0.972146s (0.407665s in 8 GCs)
  ;; Elapsed time: 0.709619s (0.255678s in 5 GCs)
  ;; Elapsed time: 0.947108s (0.397916s in 8 GCs)
  ;; Elapsed time: 0.727231s (0.254040s in 5 GCs)
  ;; Elapsed time: 0.966196s (0.398492s in 8 GCs)
  ;; Elapsed time: 0.701558s (0.252168s in 5 GCs)
  ;; Elapsed time: 0.936269s (0.388110s in 8 GCs)
  ;; Elapsed time: 0.694050s (0.249759s in 5 GCs)

  ;; with my lazy-hilit patch worked minimally by Dmitry
  ;; 
  ;; Elapsed time: 1.779906s (0.975332s in 15 GCs)
  ;; Elapsed time: 1.342160s (0.490314s in 5 GCs)
  ;; Elapsed time: 1.235759s (0.420019s in 4 GCs)
  ;; Elapsed time: 1.363909s (0.519521s in 5 GCs)
  ;; Elapsed time: 1.175773s (0.423938s in 4 GCs)
  ;; Elapsed time: 1.340017s (0.508744s in 5 GCs)
  ;; Elapsed time: 1.124552s (0.404149s in 4 GCs)
  ;; Elapsed time: 1.327419s (0.499433s in 5 GCs)
  ;; Elapsed time: 1.121927s (0.400499s in 4 GCs)
  ;; Elapsed time: 1.308526s (0.493652s in 5 GCs)
  ;; Elapsed time: 1.159132s (0.404612s in 4 GCs)
  ;; Elapsed time: 1.323803s (0.500754s in 5 GCs)
  ;; Elapsed time: 1.128562s (0.406496s in 4 GCs)
  ;; Elapsed time: 1.345577s (0.503971s in 5 GCs)
  ;; Elapsed time: 1.121691s (0.401876s in 4 GCs)
  ;; Elapsed time: 1.304913s (0.492255s in 5 GCs)
  ;; Elapsed time: 1.141926s (0.399154s in 4 GCs)
  ;; Elapsed time: 1.312480s (0.498205s in 5 GCs)
  ;; Elapsed time: 1.125095s (0.403174s in 4 GCs)
  ;; Elapsed time: 1.332119s (0.503671s in 5 GCs)
  ;; Elapsed time: 1.131561s (0.402268s in 4 GCs)

  ;; New lazy-hilit patch attached:
  ;;
  ;; Elapsed time: 0.902985s (0.224307s in 3 GCs)
  ;; Elapsed time: 0.696391s (0.079687s in 1 GCs)
  ;; Elapsed time: 0.896176s (0.219964s in 3 GCs)
  ;; Elapsed time: 0.648318s (0.074765s in 1 GCs)
  ;; Elapsed time: 0.906288s (0.221534s in 3 GCs)
  ;; Elapsed time: 0.679141s (0.079102s in 1 GCs)
  ;; Elapsed time: 0.889320s (0.222668s in 3 GCs)
  ;; Elapsed time: 0.690199s (0.076926s in 1 GCs)
  ;; Elapsed time: 0.912206s (0.220297s in 3 GCs)
  ;; Elapsed time: 0.675524s (0.078875s in 1 GCs)
  ;; Elapsed time: 0.907111s (0.226627s in 3 GCs)
  ;; Elapsed time: 0.697139s (0.079571s in 1 GCs)
  ;; Elapsed time: 0.906650s (0.220946s in 3 GCs)
  ;; Elapsed time: 0.683808s (0.078001s in 1 GCs)
  ;; Elapsed time: 0.912471s (0.221977s in 3 GCs)
  ;; Elapsed time: 0.699742s (0.079009s in 1 GCs)
  ;; Elapsed time: 0.897566s (0.217786s in 3 GCs)
  ;; Elapsed time: 0.659043s (0.076046s in 1 GCs)

  Daniel+Dmitry patch v3:        0.8308954444444444s avg
  Old lazy-hilit patch:          1.2390678333333334s avg
  New lazy-hilit patch attached: 0.7922265555555554s avg

In conclusion:

* I think the two approaches are basically evenly matched in terms of
  performance, at least for this symbol completion scenario.

* In the completion-{sorted|all}-completions micro-benchmark my patch
  does very marginally worse (0.6%).  Probably because of the use of a
  hash table.  I believe I can fix this, though.

* In the icomplete.el usability test, my new patch probably does
  slightly better (4.6%).  Probably because it doesn't recalculate the
  regexp from the pattern every time it needs to late highlight.

* My patch doesn't suffer from the 'completion--unquoted' property
  complication in Daniel+Dmitry's patch."  It's possible/likely that the
  additional memory needed by this property will introduce an additional
  slowdown which isn't visible in the simpler symbol completion
  scenario.

Both patches propose what are effectively extensions to the large, old
and complicated completion API, in my case an additional variable to
bind (or set), in Daniel's patch a brand new API entry point and the
deprecation of an existing one.

The benchmarks show that Daniel's patch is not absolutely necessary to
reap the benefits of deferred/lazy/late/just-in-time highlighting.

Looking at the two patches side-by-side it seems evident to me that one
patch is much simpler than the other.  The "maybe-alist-maybe-not" flag
dedicated to completely changing the meaning of a number of
minibuffer.el functions while keeping backward compatibility is one such
item of complexity.

Therefore, since we can come up with simpler alternatives that bring
these now well-understood benefits, it won't surprise anyone that I
think we should go for the simpler choice.

João

>From 78057f40e53f39f0b26f4b9bf5d950b72f1c3d99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= <[email-masked]>
Date: Wed, 25 Oct 2023 13:45:01 +0100
Subject: [PATCH] Allow completion frontends to highlight completion strings
 just-in-time

This allows completion-pcm--hilit-commonality to be sped up
substantially.

Introduce a new variable completion-lazy-hilit that allows for
completion frontends to opt-in an time-saving optimization by some
completions styles, such as the 'flex' and 'pcm' styles.

The variable must be bound or set by the frontend to a unique value
around a completion attempt/session.  See completion-lazy-hilit
docstring for more info.

* lisp/icomplete.el (icomplete-minibuffer-setup): Set completion-lazy-hilit.
(icomplete--render-vertical): Call completion-lazy-hilit.
(icomplete-completions): Call completion-lazy-hilit.

* lisp/minibuffer.el (completion-lazy-hilit): New variable.
(completion-lazy-hilit)
(completion--hilit-from-re): New functions.
(completion--lazy-hilit-table): New variable.
(completion--flex-score-1): New helper.
(completion-pcm--hilit-commonality): Use completion-lazy-hilit.
---
 lisp/icomplete.el  |   9 +-
 lisp/minibuffer.el | 262 +++++++++++++++++++++++++++++----------------
 2 files changed, 173 insertions(+), 98 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index e6fdd1f1836..a9ac0b3f040 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -545,6 +545,7 @@ icomplete-minibuffer-setup
     (setq-local icomplete--initial-input (icomplete--field-string))
     (setq-local completion-show-inline-help nil)
     (setq icomplete--scrolled-completions nil)
+    (setq completion-lazy-hilit (cl-gensym))
     (use-local-map (make-composed-keymap icomplete-minibuffer-map
     					 (current-local-map)))
     (add-hook 'post-command-hook #'icomplete-post-command-hook nil t)
@@ -754,12 +755,13 @@ icomplete-exhibit
                            (overlay-end rfn-eshadow-overlay)))
           (let* ((field-string (icomplete--field-string))
                  (text (while-no-input
+                         (benchmark-progn
                          (icomplete-completions
                           field-string
                           (icomplete--completion-table)
                           (icomplete--completion-predicate)
                           (if (window-minibuffer-p)
-                              (eq minibuffer--require-match t)))))
+                              (eq minibuffer--require-match t))))))
                  (buffer-undo-list t)
                  deactivate-mark)
             ;; Do nothing if while-no-input was aborted.
@@ -901,7 +903,7 @@ icomplete--render-vertical
                                 'icomplete-selected-match 'append comp)
      collect (concat prefix
                      (make-string (- max-prefix-len (length prefix)) ? )
-                     comp
+                     (completion-lazy-hilit comp)
                      (make-string (- max-comp-len (length comp)) ? )
                      suffix)
      into lines-aux
@@ -1067,7 +1069,8 @@ icomplete-completions
                   (if (< prospects-len prospects-max)
                       (push comp prospects)
                     (setq limit t)))
-                (setq prospects (nreverse prospects))
+                (setq prospects
+                      (nreverse (mapcar #'completion-lazy-hilit prospects)))
                 ;; Decorate first of the prospects.
                 (when prospects
                   (let ((first (copy-sequence (pop prospects))))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 2120e31775e..4591f1145c8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3749,108 +3749,180 @@ flex-score-match-tightness
 than the latter (which has two \"holes\" and three
 one-letter-long matches).")
 
+(defvar-local completion-lazy-hilit nil
+  "If non-nil, request completion lazy hilighting.
+
+Completion-presenting frontends may opt to bind this variable to
+a unique non-nil value in the context of completion-producing
+calls (such as `completion-all-sorted-completions').  This hints
+the intervening completion styles that they do not need to
+propertize completion strings with the `face' property.
+
+When doing so, it is the frontend -- not the style -- who becomes
+responsible for `face'-propertizing only the completion strings
+that are meant to be displayed to the user.  This can be done by
+calling the function `completion-lazy-hilit' which returns a
+`face'-propertized string.
+
+The value stored in this variable by the completion frontend
+should be unique to each completion attempt or session that
+utilizes the same completion style in `completion-styles-alist'.
+For frontends using the minibuffer as the locus of completion
+calls and display, setting it to a buffer-local value given by
+`gensym' is appropriate.  For frontends operating entirely in a
+single command, let-binding it to `gensym' is appropriate.
+
+Note that the optimization enabled by variable is only actually
+performed some completions styles.  To others, it is a harmless
+and useless hint.  To author a completion style that takes
+advantage of this, look in the source of
+`completion-pcm--hilit-commonality'.")
+
+(defun completion-lazy-hilit (str)
+  "Return a copy of completion STR that is `face'-propertized.
+See documentation for variable `completion-lazy-hilit' for more
+details."
+  (completion--hilit-from-re
+   (copy-sequence str)
+   (gethash completion-lazy-hilit completion--lazy-hilit-table)))
+
+(defun completion--hilit-from-re (string regexp)
+  "Fontify STRING with `completions-common-part' using REGEXP."
+  (let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
+         (me (and md (match-end 0)))
+         (from 0))
+    (while md
+      (add-face-text-property from (pop md) 'completions-common-part nil string)
+      (setq from (pop md)))
+    (unless (or (not me) (= from me))
+      (add-face-text-property from me 'completions-common-part nil string))
+    string))
+
+(defun completion--flex-score-1 (md match-end len)
+  "Compute matching score of completion.
+The score lies in the range between 0 and 1, where 1 corresponds to
+the full match.
+MD is the match data.
+MATCH-END is the end of the match.
+LEN is the length of the completion string."
+  (let* ((from 0)
+         ;; To understand how this works, consider these simple
+         ;; ascii diagrams showing how the pattern "foo"
+         ;; flex-matches "fabrobazo", "fbarbazoo" and
+         ;; "barfoobaz":
+
+         ;;      f abr o baz o
+         ;;      + --- + --- +
+
+         ;;      f barbaz oo
+         ;;      + ------ ++
+
+         ;;      bar foo baz
+         ;;          +++
+
+         ;; "+" indicates parts where the pattern matched.  A
+         ;; "hole" in the middle of the string is indicated by
+         ;; "-".  Note that there are no "holes" near the edges
+         ;; of the string.  The completion score is a number
+         ;; bound by (0..1] (i.e., larger than (but not equal
+         ;; to) zero, and smaller or equal to one): the higher
+         ;; the better and only a perfect match (pattern equals
+         ;; string) will have score 1.  The formula takes the
+         ;; form of a quotient.  For the numerator, we use the
+         ;; number of +, i.e. the length of the pattern.  For
+         ;; the denominator, it first computes
+         ;;
+         ;;     hole_i_contrib = 1 + (Li-1)^(1/tightness)
+         ;;
+         ;; , for each hole "i" of length "Li", where tightness
+         ;; is given by `flex-score-match-tightness'.  The
+         ;; final value for the denominator is then given by:
+         ;;
+         ;;    (SUM_across_i(hole_i_contrib) + 1) * len
+         ;;
+         ;; , where "len" is the string's length.
+         (score-numerator 0)
+         (score-denominator 0)
+         (last-b 0))
+    (while md
+      (let ((a from)
+            (b (pop md)))
+        (setq
+         score-numerator   (+ score-numerator (- b a)))
+        (unless (or (= a last-b)
+                    (zerop last-b)
+                    (= a len))
+          (setq
+           score-denominator (+ score-denominator
+                                1
+                                (expt (- a last-b 1)
+                                      (/ 1.0
+                                         flex-score-match-tightness)))))
+        (setq
+         last-b              b))
+      (setq from (pop md)))
+    ;; If `pattern' doesn't have an explicit trailing any, the
+    ;; regex `re' won't produce match data representing the
+    ;; region after the match.  We need to account to account
+    ;; for that extra bit of match (bug#42149).
+    (unless (= from match-end)
+      (let ((a from)
+            (b match-end))
+        (setq
+         score-numerator   (+ score-numerator (- b a)))
+        (unless (or (= a last-b)
+                    (zerop last-b)
+                    (= a len))
+          (setq
+           score-denominator (+ score-denominator
+                                1
+                                (expt (- a last-b 1)
+                                      (/ 1.0
+                                         flex-score-match-tightness)))))
+        (setq
+         last-b              b)))
+    (/ score-numerator (* len (1+ score-denominator)) 1.0)))
+
+(defvar completion--lazy-hilit-table (make-hash-table :weakness 'key))
+
 (defun completion-pcm--hilit-commonality (pattern completions)
   "Show where and how well PATTERN matches COMPLETIONS.
 PATTERN, a list of symbols and strings as seen
 `completion-pcm--merge-completions', is assumed to match every
-string in COMPLETIONS.  Return a deep copy of COMPLETIONS where
-each string is propertized with `completion-score', a number
-between 0 and 1, and with faces `completions-common-part',
-`completions-first-difference' in the relevant segments."
+string in COMPLETIONS.
+
+If `completion-lazy-hilit' is nil, return a deep copy of
+COMPLETIONS where each string is propertized with
+`completion-score', a number between 0 and 1, and with faces
+`completions-common-part', `completions-first-difference' in the
+relevant segments.
+
+Else, if `completion-lazy-hilit' is t, return COMPLETIONS where
+each string now has a `completion-score' property and no
+highlighting."
   (cond
    ((and completions (cl-loop for e in pattern thereis (stringp e)))
     (let* ((re (completion-pcm--pattern->regex pattern 'group))
-           (point-idx (completion-pcm--pattern-point-idx pattern))
-           (case-fold-search completion-ignore-case)
-           last-md)
-      (mapcar
-       (lambda (str)
-	 ;; Don't modify the string itself.
-         (setq str (copy-sequence str))
-         (unless (string-match re str)
-           (error "Internal error: %s does not match %s" re str))
-         (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
-                (match-end (match-end 0))
-                (md (cddr (setq last-md (match-data t last-md))))
-                (from 0)
-                (end (length str))
-                ;; To understand how this works, consider these simple
-                ;; ascii diagrams showing how the pattern "foo"
-                ;; flex-matches "fabrobazo", "fbarbazoo" and
-                ;; "barfoobaz":
-
-                ;;      f abr o baz o
-                ;;      + --- + --- +
-
-                ;;      f barbaz oo
-                ;;      + ------ ++
-
-                ;;      bar foo baz
-                ;;          +++
-
-                ;; "+" indicates parts where the pattern matched.  A
-                ;; "hole" in the middle of the string is indicated by
-                ;; "-".  Note that there are no "holes" near the edges
-                ;; of the string.  The completion score is a number
-                ;; bound by (0..1] (i.e., larger than (but not equal
-                ;; to) zero, and smaller or equal to one): the higher
-                ;; the better and only a perfect match (pattern equals
-                ;; string) will have score 1.  The formula takes the
-                ;; form of a quotient.  For the numerator, we use the
-                ;; number of +, i.e. the length of the pattern.  For
-                ;; the denominator, it first computes
-                ;;
-                ;;     hole_i_contrib = 1 + (Li-1)^(1/tightness)
-                ;;
-                ;; , for each hole "i" of length "Li", where tightness
-                ;; is given by `flex-score-match-tightness'.  The
-                ;; final value for the denominator is then given by:
-                ;;
-                ;;    (SUM_across_i(hole_i_contrib) + 1) * len
-                ;;
-                ;; , where "len" is the string's length.
-                (score-numerator 0)
-                (score-denominator 0)
-                (last-b 0)
-                (update-score-and-face
-                 (lambda (a b)
-                   "Update score and face given match range (A B)."
-                   (add-face-text-property a b
-                                           'completions-common-part
-                                           nil str)
-                   (setq
-                    score-numerator   (+ score-numerator (- b a)))
-                   (unless (or (= a last-b)
-                               (zerop last-b)
-                               (= a (length str)))
-                     (setq
-                      score-denominator (+ score-denominator
-                                           1
-                                           (expt (- a last-b 1)
-                                                 (/ 1.0
-                                                    flex-score-match-tightness)))))
-                   (setq
-                    last-b              b))))
-           (while md
-             (funcall update-score-and-face from (pop md))
-             (setq from (pop md)))
-           ;; If `pattern' doesn't have an explicit trailing any, the
-           ;; regex `re' won't produce match data representing the
-           ;; region after the match.  We need to account to account
-           ;; for that extra bit of match (bug#42149).
-           (unless (= from match-end)
-             (funcall update-score-and-face from match-end))
-           (if (> (length str) pos)
-               (add-face-text-property
-                pos (1+ pos)
-                'completions-first-difference
-                nil str))
-           (unless (zerop (length str))
-             (put-text-property
-              0 1 'completion-score
-              (/ score-numerator (* end (1+ score-denominator)) 1.0) str)))
-         str)
-       completions)))
+           last-md
+           (score (lambda (str)
+                    (unless (string-match re str)
+                      (error "Internal error: %s does not match %s" re str))
+                    (let* ((match-end (match-end 0))
+                           (md (cddr (setq last-md (match-data t last-md)))))
+                      (completion--flex-score-1 md match-end (length str))))))
+      (cond (completion-lazy-hilit
+             (puthash completion-lazy-hilit re completion--lazy-hilit-table)
+             (mapc (lambda (str)
+                     (put-text-property 0 1 'completion-score (funcall score str) str))
+                   completions))
+            (t
+             (mapcar
+              (lambda (str)
+                (setq str (copy-sequence str))
+                (put-text-property 0 1 'completion-score (funcall score str) str)
+                (completion--hilit-from-re str re)
+                str)
+              completions)))))
    (t completions)))
 
 (defun completion-pcm--find-all-completions (string table pred point
-- 
2.39.2