master 7a6cc97: Avoid excessive specbinding in all-completions

[Lars Ingebrigtsen]

branch: master
commit 7a6cc97f3c2fe8c01ac71e39514a73c0674b9061
Author: Miha Rihtaršič <miha@kamnitnik.top>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Avoid excessive specbinding in all-completions
    
    * src/minibuf.c (match_regexps):
    (Ftry_completion):
    (Fall_completions):
    (Ftest_completion): Use fast_string_match_internal to match against
    regexps in completion-regexp-list without having to bind
    case-fold-search.
---
 src/minibuf.c | 105 ++++++++++++++++++----------------------------------------
 1 file changed, 32 insertions(+), 73 deletions(-)

diff --git a/src/minibuf.c b/src/minibuf.c
index 0dc340e..6c0cd35 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1545,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, 
Lisp_Object basis)
     return Fstring_make_multibyte (string);
 }
 
+static bool
+match_regexps (Lisp_Object string, Lisp_Object regexps,
+              bool ignore_case)
+{
+  ptrdiff_t val;
+  for (; CONSP (regexps); regexps = XCDR (regexps))
+    {
+      CHECK_STRING (XCAR (regexps));
+
+      val = fast_string_match_internal
+       (XCAR (regexps), string,
+        (ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil));
+
+      if (val == -2)
+       error ("Stack overflow in regexp matcher");
+      if (val < 0)
+       return false;
+    }
+  return true;
+}
+
 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
        doc: /* Return common substring of all completions of STRING in 
COLLECTION.
 Test each possible completion specified by COLLECTION
@@ -1578,6 +1599,7 @@ Additionally to this predicate, `completion-regexp-list'
 is used to further constrain the set of candidates.  */)
   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
 {
+
   Lisp_Object bestmatch, tail, elt, eltstring;
   /* Size in bytes of BESTMATCH.  */
   ptrdiff_t bestmatchsize = 0;
@@ -1591,7 +1613,6 @@ is used to further constrain the set of candidates.  */)
               ? list_table : function_table));
   ptrdiff_t idx = 0, obsize = 0;
   int matchcount = 0;
-  ptrdiff_t bindcount = -1;
   Lisp_Object bucket, zero, end, tem;
 
   CHECK_STRING (string);
@@ -1670,27 +1691,10 @@ is used to further constrain the set of candidates.  */)
                                      completion_ignore_case ? Qt : Qnil),
              EQ (Qt, tem)))
        {
-         /* Yes.  */
-         Lisp_Object regexps;
-
          /* Ignore this element if it fails to match all the regexps.  */
-         {
-           for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-                regexps = XCDR (regexps))
-             {
-               if (bindcount < 0)
-                 {
-                   bindcount = SPECPDL_INDEX ();
-                   specbind (Qcase_fold_search,
-                             completion_ignore_case ? Qt : Qnil);
-                 }
-               tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
-               if (NILP (tem))
-                 break;
-             }
-           if (CONSP (regexps))
-             continue;
-         }
+         if (!match_regexps (eltstring, Vcompletion_regexp_list,
+                             completion_ignore_case))
+           continue;
 
          /* Ignore this element if there is a predicate
             and the predicate doesn't like it.  */
@@ -1701,11 +1705,6 @@ is used to further constrain the set of candidates.  */)
                tem = Fcommandp (elt, Qnil);
              else
                {
-                 if (bindcount >= 0)
-                   {
-                     unbind_to (bindcount, Qnil);
-                     bindcount = -1;
-                   }
                  tem = (type == hash_table
                         ? call2 (predicate, elt,
                                  HASH_VALUE (XHASH_TABLE (collection),
@@ -1787,9 +1786,6 @@ is used to further constrain the set of candidates.  */)
        }
     }
 
-  if (bindcount >= 0)
-    unbind_to (bindcount, Qnil);
-
   if (NILP (bestmatch))
     return Qnil;               /* No completions found.  */
   /* If we are ignoring case, and there is no exact match,
@@ -1849,7 +1845,6 @@ with a space are ignored unless STRING itself starts with 
a space.  */)
     : VECTORP (collection) ? 2
     : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
   ptrdiff_t idx = 0, obsize = 0;
-  ptrdiff_t bindcount = -1;
   Lisp_Object bucket, tem, zero;
 
   CHECK_STRING (string);
@@ -1934,27 +1929,10 @@ with a space are ignored unless STRING itself starts 
with a space.  */)
                                      completion_ignore_case ? Qt : Qnil),
              EQ (Qt, tem)))
        {
-         /* Yes.  */
-         Lisp_Object regexps;
-
          /* Ignore this element if it fails to match all the regexps.  */
-         {
-           for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-                regexps = XCDR (regexps))
-             {
-               if (bindcount < 0)
-                 {
-                   bindcount = SPECPDL_INDEX ();
-                   specbind (Qcase_fold_search,
-                             completion_ignore_case ? Qt : Qnil);
-                 }
-               tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
-               if (NILP (tem))
-                 break;
-             }
-           if (CONSP (regexps))
-             continue;
-         }
+         if (!match_regexps (eltstring, Vcompletion_regexp_list,
+                             completion_ignore_case))
+           continue;
 
          /* Ignore this element if there is a predicate
             and the predicate doesn't like it.  */
@@ -1965,11 +1943,6 @@ with a space are ignored unless STRING itself starts 
with a space.  */)
                tem = Fcommandp (elt, Qnil);
              else
                {
-                 if (bindcount >= 0)
-                   {
-                     unbind_to (bindcount, Qnil);
-                     bindcount = -1;
-                   }
                  tem = type == 3
                    ? call2 (predicate, elt,
                             HASH_VALUE (XHASH_TABLE (collection), idx - 1))
@@ -1982,9 +1955,6 @@ with a space are ignored unless STRING itself starts with 
a space.  */)
        }
     }
 
-  if (bindcount >= 0)
-    unbind_to (bindcount, Qnil);
-
   return Fnreverse (allmatches);
 }
 
@@ -2068,7 +2038,7 @@ If COLLECTION is a function, it is called with three 
arguments:
 the values STRING, PREDICATE and `lambda'.  */)
   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
 {
-  Lisp_Object regexps, tail, tem = Qnil;
+  Lisp_Object tail, tem = Qnil;
   ptrdiff_t i = 0;
 
   CHECK_STRING (string);
@@ -2154,20 +2124,9 @@ the values STRING, PREDICATE and `lambda'.  */)
     return call3 (collection, string, predicate, Qlambda);
 
   /* Reject this element if it fails to match all the regexps.  */
-  if (CONSP (Vcompletion_regexp_list))
-    {
-      ptrdiff_t count = SPECPDL_INDEX ();
-      specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
-      for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-          regexps = XCDR (regexps))
-       {
-          /* We can test against STRING, because if we got here, then
-             the element is equivalent to it.  */
-          if (NILP (Fstring_match (XCAR (regexps), string, Qnil, Qnil)))
-           return unbind_to (count, Qnil);
-       }
-      unbind_to (count, Qnil);
-    }
+  if (!match_regexps (string, Vcompletion_regexp_list,
+                     completion_ignore_case))
+    return Qnil;
 
   /* Finally, check the predicate.  */
   if (!NILP (predicate))