master b16cd3f 1/2: Hoist some loop-invariant variable bindings in compile.el

[Mattias Engdegård]

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

    Hoist some loop-invariant variable bindings in compile.el
    
    * lisp/progmodes/compile.el (compilation-parse-errors):
    Hoist the binding of case-fold-search and a memq call out of
    the loop, eliminating a minor but unnecessary quadratic term.
---
 lisp/progmodes/compile.el | 197 +++++++++++++++++++++++-----------------------
 1 file changed, 99 insertions(+), 98 deletions(-)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index bc0fe6d..6c819db 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1473,105 +1473,106 @@ This updates the appropriate variable used by the 
mode-line."
   "Parse errors between START and END.
 The errors recognized are the ones specified in RULES which default
 to `compilation-error-regexp-alist' if RULES is nil."
-  (dolist (item (or rules compilation-error-regexp-alist))
-    (if (symbolp item)
-        (setq item (cdr (assq item
-                              compilation-error-regexp-alist-alist))))
-    (let ((case-fold-search compilation-error-case-fold-search)
-          (file (nth 1 item))
-          (line (nth 2 item))
-          (col (nth 3 item))
-          (type (nth 4 item))
-          (pat (car item))
-          end-line end-col fmt
-          props)
-
-      ;; omake reports some error indented, so skip the indentation.
-      ;; another solution is to modify (some?) regexps in
-      ;; `compilation-error-regexp-alist'.
-      ;; note that omake usage is not limited to ocaml and C (for stubs).
-      ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
-      ;; whether or not omake's own error messages are recognized.
-      (cond
-       ((not (memq 'omake compilation-error-regexp-alist)) nil)
-       ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
-        nil) ;; Not anchored or anchored but already allows empty spaces.
-       (t (setq pat (concat "^\\(?:      \\)?" (substring pat 1)))))
-
-      (if (and (consp file) (not (functionp file)))
-         (setq fmt (cdr file)
-                file (car file)))
-      (if (and (consp line) (not (functionp line)))
-          (setq end-line (cdr line)
-                line (car line)))
-      (if (and (consp col) (not (functionp col)))
-          (setq end-col (cdr col)
-                col (car col)))
-
-      (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
-        (error "HYPERLINK should be an integer: %s" (nth 5 item)))
-
-      (goto-char start)
-      (while (re-search-forward pat end t)
-        (when (setq props (compilation-error-properties
-                           file line end-line col end-col (or type 2) fmt))
-
-          (when (integerp file)
-            (let ((this-type (if (consp type)
-                                 (compilation-type type)
-                               (or type 2))))
-              (compilation--note-type this-type)
-
-              (compilation--put-prop
-               file 'font-lock-face
-               (symbol-value (aref [compilation-info-face
-                                    compilation-warning-face
-                                    compilation-error-face]
-                                   this-type)))))
-
-          (compilation--put-prop
-           line 'font-lock-face compilation-line-face)
-          (compilation--put-prop
-           end-line 'font-lock-face compilation-line-face)
-
-          (compilation--put-prop
-           col 'font-lock-face compilation-column-face)
-          (compilation--put-prop
-           end-col 'font-lock-face compilation-column-face)
-
-         ;; Obey HIGHLIGHT.
-          (dolist (extra-item (nthcdr 6 item))
-            (let ((mn (pop extra-item)))
-              (when (match-beginning mn)
-                (let ((face (eval (car extra-item))))
-                  (cond
-                   ((null face))
-                   ((or (symbolp face) (stringp face))
-                    (put-text-property
-                     (match-beginning mn) (match-end mn)
-                     'font-lock-face face))
-                  ((and (listp face)
-                        (eq (car face) 'face)
-                        (or (symbolp (cadr face))
-                            (stringp (cadr face))))
-                    (compilation--put-prop mn 'font-lock-face (cadr face))
-                    (add-text-properties
-                     (match-beginning mn) (match-end mn)
-                     (nthcdr 2 face)))
-                   (t
-                    (error "Don't know how to handle face %S"
-                           face)))))))
-          (let ((mn (or (nth 5 item) 0)))
-            (when compilation-debug
+  (let ((case-fold-search compilation-error-case-fold-search)
+        (omake-included (memq 'omake compilation-error-regexp-alist)))
+    (dolist (item (or rules compilation-error-regexp-alist))
+      (if (symbolp item)
+          (setq item (cdr (assq item
+                                compilation-error-regexp-alist-alist))))
+      (let ((file (nth 1 item))
+            (line (nth 2 item))
+            (col (nth 3 item))
+            (type (nth 4 item))
+            (pat (car item))
+            end-line end-col fmt
+            props)
+
+        ;; omake reports some error indented, so skip the indentation.
+        ;; another solution is to modify (some?) regexps in
+        ;; `compilation-error-regexp-alist'.
+        ;; note that omake usage is not limited to ocaml and C (for stubs).
+        ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
+        ;; whether or not omake's own error messages are recognized.
+        (cond
+         ((not omake-included) nil)
+         ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
+          nil) ;; Not anchored or anchored but already allows empty spaces.
+         (t (setq pat (concat "^\\(?:      \\)?" (substring pat 1)))))
+
+        (if (and (consp file) (not (functionp file)))
+            (setq fmt (cdr file)
+                  file (car file)))
+        (if (and (consp line) (not (functionp line)))
+            (setq end-line (cdr line)
+                  line (car line)))
+        (if (and (consp col) (not (functionp col)))
+            (setq end-col (cdr col)
+                  col (car col)))
+
+        (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+          (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+
+        (goto-char start)
+        (while (re-search-forward pat end t)
+          (when (setq props (compilation-error-properties
+                             file line end-line col end-col (or type 2) fmt))
+
+            (when (integerp file)
+              (let ((this-type (if (consp type)
+                                   (compilation-type type)
+                                 (or type 2))))
+                (compilation--note-type this-type)
+
+                (compilation--put-prop
+                 file 'font-lock-face
+                 (symbol-value (aref [compilation-info-face
+                                      compilation-warning-face
+                                      compilation-error-face]
+                                     this-type)))))
+
+            (compilation--put-prop
+             line 'font-lock-face compilation-line-face)
+            (compilation--put-prop
+             end-line 'font-lock-face compilation-line-face)
+
+            (compilation--put-prop
+             col 'font-lock-face compilation-column-face)
+            (compilation--put-prop
+             end-col 'font-lock-face compilation-column-face)
+
+            ;; Obey HIGHLIGHT.
+            (dolist (extra-item (nthcdr 6 item))
+              (let ((mn (pop extra-item)))
+                (when (match-beginning mn)
+                  (let ((face (eval (car extra-item))))
+                    (cond
+                     ((null face))
+                     ((or (symbolp face) (stringp face))
+                      (put-text-property
+                       (match-beginning mn) (match-end mn)
+                       'font-lock-face face))
+                    ((and (listp face)
+                          (eq (car face) 'face)
+                          (or (symbolp (cadr face))
+                              (stringp (cadr face))))
+                      (compilation--put-prop mn 'font-lock-face (cadr face))
+                      (add-text-properties
+                       (match-beginning mn) (match-end mn)
+                       (nthcdr 2 face)))
+                     (t
+                      (error "Don't know how to handle face %S"
+                             face)))))))
+            (let ((mn (or (nth 5 item) 0)))
+              (when compilation-debug
+                (font-lock-append-text-property
+                 (match-beginning 0) (match-end 0)
+                 'compilation-debug (vector 'std item props)))
+              (add-text-properties
+               (match-beginning mn) (match-end mn)
+               (cddr props))
               (font-lock-append-text-property
-               (match-beginning 0) (match-end 0)
-               'compilation-debug (vector 'std item props)))
-            (add-text-properties
-             (match-beginning mn) (match-end mn)
-             (cddr props))
-            (font-lock-append-text-property
-             (match-beginning mn) (match-end mn)
-             'font-lock-face (cadr props))))))))
+               (match-beginning mn) (match-end mn)
+               'font-lock-face (cadr props)))))))))
 
 (defvar compilation--parsed -1)
 (make-variable-buffer-local 'compilation--parsed)