master 3096437: CC Mode: introduce a new cache for brace structures. This fixes bug #45248

[Alan Mackenzie]

branch: master
commit 3096437593ca6d1ea07809f7d0e2198705f20e55
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    CC Mode: introduce a new cache for brace structures.  This fixes bug #45248
    
    Also fix three infinite loops.  The new cache accelerates backward searches
    for struct beginnings in c-looking-at-or-maybe-in-bracelist.
    
    * lisp/progmodes/cc-engine.el (c-beginning-of-statement-1): In the final 
loop
    over unary operators, add a check (> (point) lim) to avoid certain infinite
    loops.
    (c-beginning-of-decl-1): In the first loop add a similar check on point and
    lim.
    (c-laomib-loop): New function extracted from
    c-looking-at-or-maybe-in-bracelist.
    (c-laomib-cache): New buffer local variable.
    (c-laomib-get-cache, c-laomib-put-cache, c-laomib-fix-elt)
    (c-laomib-invalidate-cache): New functions which implement the cache.
    (c-looking-at-or-maybe-in-bracelist): Replace two invocations of
    c-go-up-list-backwards with calls to c-parse-state.  Extract the new 
function
    c-laomib-loop.  Insert code which calls c-laomib-loop minimally, with the 
help
    of the new cache.
    
    * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialise the new cach
    (at mode start).
    (c-before-change): Invalidate the new cache.
    (c-fl-decl-start): Add an extra check (> (point) bod-lim) to prevent 
looping.
    Determine the enclosing brace to pass as arguments to
    c-looking-at-or-maybe-in-bracelist.
---
 lisp/progmodes/cc-engine.el | 332 ++++++++++++++++++++++++++++++++------------
 lisp/progmodes/cc-mode.el   |  34 +++--
 2 files changed, 266 insertions(+), 100 deletions(-)

diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 218bbb4..51f620e 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1414,12 +1414,14 @@ comment at the start of cc-engine.el for more info."
            (setq ret 'label)))
 
       ;; Skip over the unary operators that can start the statement.
-      (while (progn
-              (c-backward-syntactic-ws lim)
-              ;; protect AWK post-inc/decrement operators, etc.
-              (and (not (c-at-vsemi-p (point)))
-                   (/= (skip-chars-backward "-.+!*&~@`#") 0)))
+      (while (and (> (point) lim)
+                 (progn
+                   (c-backward-syntactic-ws lim)
+                   ;; protect AWK post-inc/decrement operators, etc.
+                   (and (not (c-at-vsemi-p (point)))
+                        (/= (skip-chars-backward "-.+!*&~@`#") 0))))
        (setq pos (point)))
+
       (goto-char pos)
       ret)))
 
@@ -3567,8 +3569,9 @@ mhtml-mode."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Defuns which analyze the buffer, yet don't change `c-state-cache'.
 (defun c-get-fallback-scan-pos (here)
-  ;; Return a start position for building `c-state-cache' from
-  ;; scratch.  This will be at the top level, 2 defuns back.
+  ;; Return a start position for building `c-state-cache' from scratch.  This
+  ;; will be at the top level, 2 defuns back.  Return nil if we don't find
+  ;; these defun starts a reasonable way back.
   (save-excursion
     (save-restriction
       (when (> here (* 10 c-state-cache-too-far))
@@ -11177,6 +11180,7 @@ comment at the start of cc-engine.el for more info."
                  (c-backward-syntactic-ws lim)
                  (not (or (memq (char-before) '(?\; ?} ?: nil))
                           (c-at-vsemi-p))))
+               (not (and lim (<= (point) lim)))
                (save-excursion
                  (backward-char)
                  (not (looking-at "\\s(")))
@@ -11615,6 +11619,195 @@ comment at the start of cc-engine.el for more info."
     (or (looking-at c-brace-list-key)
        (progn (goto-char here) nil))))
 
+(defun c-laomib-loop (lim)
+  ;; The "expensive" loop from `c-looking-at-or-maybe-in-bracelist'.  Move
+  ;; backwards over comma separated sexps as far as possible, but no further
+  ;; than LIM, which may be nil, meaning no limit.  Return the final value of
+  ;; `braceassignp', which is t if we encountered "= {", usually nil
+  ;; otherwise.
+  (let ((braceassignp 'dontknow)
+         (class-key
+          ;; Pike can have class definitions anywhere, so we must
+          ;; check for the class key here.
+          (and (c-major-mode-is 'pike-mode)
+               c-decl-block-key)))
+    (while (eq braceassignp 'dontknow)
+      (cond ((eq (char-after) ?\;)
+            (setq braceassignp nil))
+           ((and class-key
+                 (looking-at class-key))
+            (setq braceassignp nil))
+           ((and c-has-compound-literals
+                 (looking-at c-return-key))
+            (setq braceassignp t)
+            nil)
+           ((eq (char-after) ?=)
+            ;; We've seen a =, but must check earlier tokens so
+            ;; that it isn't something that should be ignored.
+            (setq braceassignp 'maybe)
+            (while (and (eq braceassignp 'maybe)
+                        (zerop (c-backward-token-2 1 t lim)))
+              (setq braceassignp
+                    (cond
+                     ;; Check for operator =
+                     ((and c-opt-op-identifier-prefix
+                           (looking-at c-opt-op-identifier-prefix))
+                      nil)
+                     ;; Check for `<opchar>= in Pike.
+                     ((and (c-major-mode-is 'pike-mode)
+                           (or (eq (char-after) ?`)
+                               ;; Special case for Pikes
+                               ;; `[]=, since '[' is not in
+                               ;; the punctuation class.
+                               (and (eq (char-after) ?\[)
+                                    (eq (char-before) ?`))))
+                      nil)
+                     ((looking-at "\\s.") 'maybe)
+                     ;; make sure we're not in a C++ template
+                     ;; argument assignment
+                     ((and
+                       (c-major-mode-is 'c++-mode)
+                       (save-excursion
+                         (let ((here (point))
+                               (pos< (progn
+                                       (skip-chars-backward "^<>")
+                                       (point))))
+                           (and (eq (char-before) ?<)
+                                (not (c-crosses-statement-barrier-p
+                                      pos< here))
+                                (not (c-in-literal))
+                                ))))
+                      nil)
+                     (t t)))))
+           ((and
+             (c-major-mode-is 'c++-mode)
+             (eq (char-after) ?\[)
+             ;; Be careful of "operator []"
+             (not (save-excursion
+                    (c-backward-token-2 1 nil lim)
+                    (looking-at c-opt-op-identifier-prefix))))
+            (setq braceassignp t)
+            nil))
+      (when (eq braceassignp 'dontknow)
+       (cond ((and
+               (not (eq (char-after) ?,))
+               (save-excursion
+                 (c-backward-syntactic-ws)
+                 (eq (char-before) ?})))
+              (setq braceassignp nil))
+             ((/= (c-backward-token-2 1 t lim) 0)
+              (if (save-excursion
+                    (and c-has-compound-literals
+                         (eq (c-backward-token-2 1 nil lim) 0)
+                         (eq (char-after) ?\()))
+                  (setq braceassignp t)
+                (setq braceassignp nil))))))
+    braceassignp))
+
+;; The following variable is a cache of up to four entries, each entry of
+;; which is a list representing a call to c-laomib-loop.  It contains the
+;; following elements:
+;; 0: `lim' argument - used as an alist key, never nil.
+;; 1: Position in buffer where the scan started.
+;; 2: Position in buffer where the scan ended.
+;; 3: Result of the call to `c-laomib-loop'.
+(defvar c-laomib-cache nil)
+(make-variable-buffer-local 'c-laomib-cache)
+
+(defun c-laomib-get-cache (containing-sexp)
+  ;; Get an element from `c-laomib-cache' matching CONTAINING-SEXP.
+  ;; Return that element or nil if one wasn't found.
+  (let ((elt (assq containing-sexp c-laomib-cache)))
+    (when elt
+      ;; Move the fetched `elt' to the front of the cache.
+      (setq c-laomib-cache (delq elt c-laomib-cache))
+      (push elt c-laomib-cache)
+      elt)))
+
+(defun c-laomib-put-cache (lim start end result)
+  ;; Insert a new element into `c-laomib-cache', removing another element to
+  ;; make room, if necessary.  The four parameters LIM, START, END, RESULT are
+  ;; the components of the new element (see comment for `c-laomib-cache').
+  ;; The return value is of no significance.
+  (when lim
+    (let ((old-elt (assq lim c-laomib-cache))
+         ;; (elt (cons containing-sexp (cons start nil)))
+         (new-elt (list lim start end result))
+         big-ptr
+         (cur-ptr c-laomib-cache)
+         togo togo-ptr (size 0) cur-size
+         )
+      (if old-elt (setq c-laomib-cache (delq old-elt c-laomib-cache)))
+
+      (while (>= (length c-laomib-cache) 4)
+       ;; We delete the least recently used elt which doesn't enclose START,
+       ;; or..
+       (dolist (elt c-laomib-cache)
+         (if (or (<= start (cadr elt))
+                 (> start (car (cddr elt))))
+             (setq togo elt)))
+
+       ;; ... delete the least recently used elt which isn't the biggest.
+       (when (not togo)
+         (while (cdr cur-ptr)
+           (setq cur-size (- (nth 2 (cadr cur-ptr)) (car (cadr cur-ptr))))
+           (when (> cur-size size)
+             (setq size cur-size
+                   big-ptr cur-ptr))
+           (setq cur-ptr (cdr cur-ptr)))
+         (setq togo (if (cddr big-ptr)
+                        (car (last big-ptr))
+                      (car big-ptr))))
+
+       (setq c-laomib-cache (delq togo c-laomib-cache)))
+
+      (push new-elt c-laomib-cache))))
+
+(defun c-laomib-fix-elt (lwm elt paren-state)
+  ;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either
+  ;; doing nothing, signalling it is to be deleted, or replacing its start
+  ;; point with one lower in the buffer than LWM.  PAREN-STATE is the paren
+  ;; state at LWM.  Return the corrected entry, or nil (if it needs deleting).
+  ;; Note that corrections are made by `setcar'ing the original structure,
+  ;; which thus remains intact.
+  (cond
+   ((or (not lwm) (> lwm (cadr elt)))
+    elt)
+   ((<= lwm (nth 2 elt))
+    nil)
+   (t
+    (let (cur-brace)
+      ;; Search for the last brace in `paren-state' before (car `lim').  This
+      ;; brace will become our new 2nd element of `elt'.
+      (while
+         ;; Search one brace level per iteration.
+         (and paren-state
+              (progn
+                ;; (setq cur-brace (c-laomib-next-BRACE paren-state))
+                (while
+                    ;; Go past non-brace levels, one per iteration.
+                    (and paren-state
+                         (not (eq (char-after
+                                   (c-state-cache-top-lparen paren-state))
+                                  ?{)))
+                  (setq paren-state (cdr paren-state)))
+                (cadr paren-state))
+              (> (c-state-cache-top-lparen (cdr paren-state)) (car elt)))
+       (setq paren-state (cdr paren-state)))
+      (when (cadr paren-state)
+       (setcar (cdr elt) (c-state-cache-top-lparen paren-state))
+       elt)))))
+
+(defun c-laomib-invalidate-cache (beg _end)
+  ;; Called from late in c-before-change.  Amend `c-laomib-cache' to remove
+  ;; details pertaining to the buffer after position BEG.
+  (save-excursion
+    (goto-char beg)
+    (let ((paren-state (c-parse-state)))
+      (dolist (elt c-laomib-cache)
+       (when (not (c-laomib-fix-elt beg elt paren-state))
+         (setq c-laomib-cache (delq elt c-laomib-cache)))))))
+
 (defun c-looking-at-or-maybe-in-bracelist (&optional containing-sexp lim)
   ;; Point is at an open brace.  If this starts a brace list, return a list
   ;; whose car is the buffer position of the start of the construct which
@@ -11635,14 +11828,10 @@ comment at the start of cc-engine.el for more info."
   ;; Here, "brace list" does not include the body of an enum.
   (save-excursion
     (let ((start (point))
-         (class-key
-          ;; Pike can have class definitions anywhere, so we must
-          ;; check for the class key here.
-          (and (c-major-mode-is 'pike-mode)
-               c-decl-block-key))
          (braceassignp 'dontknow)
          inexpr-brace-list bufpos macro-start res pos after-type-id-pos
-         in-paren parens-before-brace)
+         in-paren parens-before-brace
+         paren-state paren-pos)
 
       (setq res (c-backward-token-2 1 t lim))
       ;; Checks to do only on the first sexp before the brace.
@@ -11651,8 +11840,10 @@ comment at the start of cc-engine.el for more info."
               (cond
                ((and (or (not (eq res 0))
                          (eq (char-after) ?,))
-                     (c-go-up-list-backward nil lim) ; FIXME!!! Check ; `lim' 
2016-07-12.
-                     (eq (char-after) ?\())
+                     (setq paren-state (c-parse-state))
+                     (setq paren-pos (c-pull-open-brace paren-state))
+                     (eq (char-after paren-pos) ?\())
+                (goto-char paren-pos)
                 (setq braceassignp 'c++-noassign
                       in-paren 'in-paren))
                ((looking-at c-pre-id-bracelist-key)
@@ -11669,9 +11860,11 @@ comment at the start of cc-engine.el for more info."
                 (cond
                  ((or (not (eq res 0))
                       (eq (char-after) ?,))
-                  (and (c-go-up-list-backward nil lim) ; FIXME!!! Check `lim' 
2016-07-12.
-                       (eq (char-after) ?\()
-                       (setq in-paren 'in-paren)))
+                  (and (setq paren-state (c-parse-state))
+                       (setq paren-pos (c-pull-open-brace paren-state))
+                       (eq (char-after paren-pos) ?\()
+                       (setq in-paren 'in-paren)
+                       (goto-char paren-pos)))
                  ((looking-at c-pre-id-bracelist-key))
                  ((looking-at c-return-key))
                  (t (setq after-type-id-pos (point))
@@ -11724,79 +11917,36 @@ comment at the start of cc-engine.el for more info."
 
        (t
        (goto-char pos)
-       ;; Checks to do on all sexps before the brace, up to the
-       ;; beginning of the statement.
-       (while (eq braceassignp 'dontknow)
-         (cond ((eq (char-after) ?\;)
-                (setq braceassignp nil))
-               ((and class-key
-                     (looking-at class-key))
-                (setq braceassignp nil))
-               ((and c-has-compound-literals
-                     (looking-at c-return-key))
-                (setq braceassignp t)
-                nil)
-               ((eq (char-after) ?=)
-                ;; We've seen a =, but must check earlier tokens so
-                ;; that it isn't something that should be ignored.
-                (setq braceassignp 'maybe)
-                (while (and (eq braceassignp 'maybe)
-                            (zerop (c-backward-token-2 1 t lim)))
-                  (setq braceassignp
-                        (cond
-                         ;; Check for operator =
-                         ((and c-opt-op-identifier-prefix
-                               (looking-at c-opt-op-identifier-prefix))
-                          nil)
-                         ;; Check for `<opchar>= in Pike.
-                         ((and (c-major-mode-is 'pike-mode)
-                               (or (eq (char-after) ?`)
-                                   ;; Special case for Pikes
-                                   ;; `[]=, since '[' is not in
-                                   ;; the punctuation class.
-                                   (and (eq (char-after) ?\[)
-                                        (eq (char-before) ?`))))
-                          nil)
-                         ((looking-at "\\s.") 'maybe)
-                         ;; make sure we're not in a C++ template
-                         ;; argument assignment
-                         ((and
-                           (c-major-mode-is 'c++-mode)
-                           (save-excursion
-                             (let ((here (point))
-                                   (pos< (progn
-                                           (skip-chars-backward "^<>")
-                                           (point))))
-                               (and (eq (char-before) ?<)
-                                    (not (c-crosses-statement-barrier-p
-                                          pos< here))
-                                    (not (c-in-literal))
-                                    ))))
-                          nil)
-                         (t t)))))
-               ((and
-                 (c-major-mode-is 'c++-mode)
-                 (eq (char-after) ?\[)
-                ;; Be careful of "operator []"
-                 (not (save-excursion
-                        (c-backward-token-2 1 nil lim)
-                        (looking-at c-opt-op-identifier-prefix))))
-                (setq braceassignp t)
-                nil))
-         (when (eq braceassignp 'dontknow)
-           (cond ((and
-                   (not (eq (char-after) ?,))
-                   (save-excursion
-                     (c-backward-syntactic-ws)
-                     (eq (char-before) ?})))
-                  (setq braceassignp nil))
-                 ((/= (c-backward-token-2 1 t lim) 0)
-                  (if (save-excursion
-                        (and c-has-compound-literals
-                             (eq (c-backward-token-2 1 nil lim) 0)
-                             (eq (char-after) ?\()))
-                      (setq braceassignp t)
-                    (setq braceassignp nil))))))
+       (when (eq braceassignp 'dontknow)
+         (let* ((cache-entry (and containing-sexp
+                                  (c-laomib-get-cache containing-sexp)))
+                (lim2 (or (cadr cache-entry) lim))
+                sub-bassign-p)
+           (if cache-entry
+               (cond
+                ((<= (point) (cadr cache-entry))
+                 ;; We're inside the region we've already scanned over, so
+                 ;; just go to that scan's end position.
+                 (goto-char (nth 2 cache-entry))
+                 (setq braceassignp (nth 3 cache-entry)))
+                ((> (point) (cadr cache-entry))
+                 ;; We're beyond the previous scan region, so just scan as
+                 ;; far as the end of that region.
+                 (setq sub-bassign-p (c-laomib-loop lim2))
+                 (if (<= (point) (cadr cache-entry))
+                     (progn
+                       (c-laomib-put-cache containing-sexp
+                                           start (nth 2 cache-entry)
+                                           (nth 3 cache-entry) ;; sub-bassign-p
+                                           )
+                       (setq braceassignp (nth 3 cache-entry))
+                       (goto-char (nth 2 cache-entry)))
+                   (setq braceassignp sub-bassign-p)))
+                (t))
+
+             (setq braceassignp (c-laomib-loop lim))
+             (when lim
+               (c-laomib-put-cache lim start (point) braceassignp)))))
 
        (cond
         (braceassignp
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 7a11101..f6d36f5 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -639,6 +639,8 @@ that requires a literal mode spec at compile time."
   ;; doesn't work with filladapt but it's better than nothing.
   (set (make-local-variable 'fill-paragraph-function) 'c-fill-paragraph)
 
+  ;; Initialize the cache for `c-looking-at-or-maybe-in-bracelist'.
+  (setq c-laomib-cache nil)
   ;; Initialize the three literal sub-caches.
   (c-truncate-lit-pos-cache 1)
   ;; Initialize the cache of brace pairs, and opening braces/brackets/parens.
@@ -2054,7 +2056,9 @@ Note that this is a strict tail, so won't match, e.g. 
\"0x....\".")
                (if c-get-state-before-change-functions
                    (mapc (lambda (fn)
                            (funcall fn beg end))
-                         c-get-state-before-change-functions))))
+                         c-get-state-before-change-functions))
+
+               (c-laomib-invalidate-cache beg end)))
          (c-clear-string-fences))))
     (c-truncate-lit-pos-cache beg)
     ;; The following must be done here rather than in `c-after-change'
@@ -2205,7 +2209,8 @@ Note that this is a strict tail, so won't match, e.g. 
\"0x....\".")
        old-pos
        (new-pos pos)
        capture-opener
-       bod-lim bo-decl)
+       bod-lim bo-decl
+       paren-state containing-brace)
     (goto-char (c-point 'bol new-pos))
     (unless lit-start
       (setq bod-lim (c-determine-limit 500))
@@ -2224,12 +2229,16 @@ Note that this is a strict tail, so won't match, e.g. 
\"0x....\".")
           (setq old-pos (point))
           (let (pseudo)
             (while
-                (progn
-                  (c-syntactic-skip-backward "^;{}" bod-lim t)
-                  (and (eq (char-before) ?})
-                       (save-excursion
-                         (backward-char)
-                         (setq pseudo (c-cheap-inside-bracelist-p 
(c-parse-state))))))
+                (and
+                 ;; N.B. `c-syntactic-skip-backward' doesn't check (> (point)
+                 ;; lim) and can loop if that's not the case.
+                 (> (point) bod-lim)
+                 (progn
+                   (c-syntactic-skip-backward "^;{}" bod-lim t)
+                   (and (eq (char-before) ?})
+                        (save-excursion
+                          (backward-char)
+                          (setq pseudo (c-cheap-inside-bracelist-p 
(c-parse-state)))))))
               (goto-char pseudo))
             t)
           (> (point) bod-lim)
@@ -2262,7 +2271,14 @@ Note that this is a strict tail, so won't match, e.g. 
\"0x....\".")
                      (and (eq (char-before) ?{)
                           (save-excursion
                             (backward-char)
-                            (consp (c-looking-at-or-maybe-in-bracelist))))
+                            (setq paren-state (c-parse-state))
+                            (while
+                                (and
+                                 (setq containing-brace
+                                       (c-pull-open-brace paren-state))
+                                 (not (eq (char-after containing-brace) ?{))))
+                            (consp (c-looking-at-or-maybe-in-bracelist
+                                    containing-brace containing-brace))))
                      )))
           (not (bobp)))
        (backward-char))                ; back over (, [, <.