1 files changed, 197 insertions, 0 deletions

diff --git a/src/minibuf.c b/src/minibuf.c
index 5dc2b230883..f7dffc24b94 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -20,6 +20,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <errno.h>
+#include <math.h>
 
 #include <binary-io.h>
 
@@ -2279,6 +2280,201 @@ init_minibuf_once_for_pdumper (void)
   last_minibuf_string = Qnil;
 }
 
+/* FLEX/GOTOH algorithm for the 'flex' completion-style.  Adapted from
+   GOTOH, Osamu. An improved algorithm for matching biological
+   sequences. Journal of molecular biology, 1982, 162.3: 705-708.
+
+   This algorithm matches patterns to candidate strings, or needles to
+   haystacks.  It works with cost matrices: imagine rows of these
+   matrices as pattern characters, and columns as the candidate string
+   characters.  There is a -1 row, and a -1 column.  The values there
+   hold real costs used for situations "before the first ever" match of
+   a pattern character to a string character.
+
+   M and D are cost matrices.  At the end of the algorithm, M will have
+   non-infinite values only for the spots where a pattern character
+   matches a string character.  So a non-infinite M[i,j] means the i-th
+   character of the pattern matches the j-th character of the string.
+   The value stored is the lowest possible cost the algorithm had to
+   "pay" to be able to make that match there, given everything that may
+   have happened before/to the left.  An infinite value simply means no
+   match at this pattern/string position.  Note that both row and column
+   of M may have more than one match at multiple indices.  But this
+   particular implementation of the algorithm assumes they have at least
+   one match.
+
+   D (originally stands for 'Deletion' in the Gotoh paper) has "running
+   costs".  Each value D[i,j] represents what the algorithm has to pay
+   to make or extend a gap when a match is found at i+1, j+1.  By that
+   time, that cost may or may not be lower than continuing from a match
+   that had also been found at i,j.  We always pick the lowest cost, and
+   by the time we reach the final column, we know we have picked the
+   cheapest possible path choosing when to gap, and when to follow up.
+
+   Along the way, we construct P, a matrix used just for backtracking,
+   to reconstruct that path.  Maybe P isn't needed, and all the
+   information can be cleverly derived from the final state of M and D.
+   But I couldn't make it work.  */
+DEFUN ("completion--flex-score-gotoh", Fcompletion__flex_score_gotoh,
+       Scompletion__flex_score_gotoh, 2, 2, 0,
+       doc: /* Compute flex score of STR matching PAT using Gotoh
+algorithm.  Return nil if no match found, else return (COST . MATCHES)
+where COST is a fixnum (lower is better) and MATCHES is a list of match
+positions in STR.  */)
+  (Lisp_Object pat, Lisp_Object str)
+{
+  /* Pre-allocated matrices for flex completion scoring.  */
+#define FLEX_MAX_STR_SIZE 512
+#define FLEX_MAX_PAT_SIZE 128
+#define FLEX_MAX_MATRIX_SIZE FLEX_MAX_PAT_SIZE * FLEX_MAX_STR_SIZE
+  /* Macro for 2D indexing into "flat" arrays.  */
+#define MAT(matrix, i, j) ((matrix)[((i) + 1) * width + ((j) + 1)])
+
+  CHECK_STRING (pat);
+  CHECK_STRING (str);
+
+  size_t patlen = SCHARS (pat);
+  size_t strlen = SCHARS (str);
+  size_t width = strlen + 1;
+  size_t size = (patlen + 1) * width;
+
+  /* Bail if strings are empty or matrix too large.  */
+  if (patlen == 0 || strlen == 0)
+    return Qnil;
+
+  if (size > FLEX_MAX_MATRIX_SIZE)
+    return Qnil;
+
+  /* Cost constants (lower is better).  Maybe these could be
+     defcustom's?*/
+  const int gap_open_cost = 10;
+  const int gap_extend_cost = 1;
+  const int pos_inf = INT_MAX / 2;
+
+  static int M[FLEX_MAX_MATRIX_SIZE];
+  static int D[FLEX_MAX_MATRIX_SIZE];
+  static size_t P[FLEX_MAX_MATRIX_SIZE];
+
+  /* Initialize costs.  Fill both matrices with positive infinity.  */
+  for (int j = 0; j < size; j++) M[j] = pos_inf;
+  for (int j = 0; j < size; j++) D[j] = pos_inf;
+  /* Except for D[0,0], which is 0, for prioritizing matches at the
+     beginning.  Remaining elements on the first row are gap_open_cost/2
+     to represent cheaper leading gaps. */
+  for (int j = 0; j < width; j++) D[j] = gap_open_cost/2;
+  D[0] = 0;
+
+  /* Index of last match before gap started, as computed in the previous
+     row.  Used to build P.  */
+  int prev_gap_origin = -1;
+
+  /* Poor man's iterator type. */
+  typedef struct iter { int x; ptrdiff_t c; ptrdiff_t b; } iter_t;
+
+  /* Info about first match computed in the previous row. */
+  iter_t prev_match = {0,0,0};
+  /* Forward pass.  */
+  for (iter_t i = {0,0,0}; i.x < patlen; i.x++)
+    {
+      int pat_char = fetch_string_char_advance(pat, &i.c, &i.b);
+      int gap_origin = -1;
+      bool match_seen = false;
+
+      for (iter_t j = prev_match; j.x < strlen; j.x++)
+        {
+          iter_t jcopy = j; /* else advance function destroys it... */
+          int str_char
+            = fetch_string_char_advance (str, &j.c, &j.b);
+
+          /* Check if characters match (case-insensitive if needed).  */
+          bool cmatch;
+          if (completion_ignore_case)
+            cmatch = (downcase (pat_char) == downcase (str_char));
+          else
+            cmatch = (pat_char == str_char);
+
+          /* Compute match cost M[i][j], i.e. replace its infinite
+             value with something finite. */
+          if (cmatch)
+            {
+              if (!match_seen)
+                {
+                  match_seen = true;
+                  prev_match = jcopy;
+                }
+              int pmatch_cost = MAT (M, i.x - 1, j.x - 1);
+              int pgap_cost = MAT (D, i.x - 1, j.x - 1);
+
+              if (pmatch_cost <= pgap_cost)
+                {
+                  /* Not only did the previous char also match (else
+                     pmatch_cost would have been infinite) but following
+                     it up with this match is best overall.  */
+                  MAT (M, i.x, j.x) = pmatch_cost;
+                  MAT (P, i.x, j.x) = j.x - 1;
+                }
+              else
+                {
+                  /* Gapping is best, regardless of whether the previous
+                     char also matched.  That is, it's better to arrive at
+                     this match from a gap.  */
+                  MAT (M, i.x, j.x) = pgap_cost;
+                  MAT (P, i.x, j.x) = prev_gap_origin;
+                }
+            }
+
+          /* Regardless of a match here, compute D[i,j], the best
+             accumulated gapping cost at this point, considering whether
+             it's more advantageous to open from a previous match on
+             this row (a cost which may well be infinite if no such
+             match ever existed) or extend a gap started sometime
+             before.  The next iteration will take this into account,
+             and so will the next row when analyzing a possible match
+             for the j+1-th string character.  */
+          int open_cost = MAT (M, i.x, j.x - 1) + gap_open_cost;
+          int extend_cost = MAT (D, i.x, j.x - 1) + gap_extend_cost;
+
+          if (open_cost < extend_cost)
+            {
+              MAT (D, i.x, j.x) = open_cost;
+              gap_origin = j.x - 1; /* New gap. */
+            }
+          else
+            MAT (D, i.x, j.x) = extend_cost; /* Extend gap.  */
+        }
+      prev_gap_origin = gap_origin;
+    }
+
+  /* Find best (lowest) cost in last row.  */
+  int best_cost = pos_inf;
+  int lastcol = -1;
+
+  for (int j = 0; j < strlen; j++)
+    {
+      int cost = MAT (M, patlen - 1, j);
+      if (cost < best_cost)
+        {
+          best_cost = cost;
+          lastcol = j;
+        }
+    }
+
+  if (lastcol < 0 || best_cost >= pos_inf)
+    return Qnil;
+
+  /* Build match positions list by tracing back through P matrix.  */
+  Lisp_Object matches = Qnil;
+  for (int i = patlen - 1, l = lastcol; i >= 0 && l >= 0; i--)
+    {
+      matches = Fcons (make_fixnum (l), matches);
+      l = MAT (P, i, l);
+    }
+
+  return Fcons (make_fixnum (best_cost), matches);
+#undef MAT
+
+}
+
 void
 syms_of_minibuf (void)
 {
@@ -2541,6 +2737,7 @@ showing the *Completions* buffer, if any.  */);
   defsubr (&Stest_completion);
   defsubr (&Sassoc_string);
   defsubr (&Scompleting_read);
+  defsubr (&Scompletion__flex_score_gotoh);
   DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit");
   DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer");
   DEFSYM (Qcompleting_read_function, "completing-read-function");