Re: builds are getting slower?

[Artur Malabarba]

2015-12-15 8:18 GMT+00:00 Glenn Morris <address@hidden>:
>
> On investigation, I find 2e84888 caused a 20% increase in build time.
>

Looks like that's my commit. I'm attaching the diff of this commit
below so that people can have a look and help pinpoint something.
I only see 2 things that could be to blame:

1. dir-locals-find-file changed quite a bit. I suspect it is called
once for each .el file we compile? In this situation, the local-vars
cache should kick in and avoid the slowness, but maybe there's a bug
where the cache is not being used.
2. There's a new (require 'map) inside one of the functions and a
(require 'seq) inside another. (I put these inside the functions so
that they would only be loaded when necessary, but if it's getting
loaded at boot, perhaps these should just go at the top level). Anyway
(require 'seq) could be a bit heavy because it uses cl-generic and
cl-extra, but I'd be really surprised if this amounted to 20% of the
build time.

--------------------------------------------------------------------------------
@ 2e8488858c7b8df40610c1cd3038348fdc9bf3ed
Author:     Artur Malabarba <address@hidden>
AuthorDate: Sat Nov 7 13:54:56 2015 +0000
Commit:     Artur Malabarba <address@hidden>
CommitDate: Tue Nov 10 13:04:31 2015 +0000

Parent:     cbaa040 * lisp/emacs-lisp/map.el (map-merge-with): New function
Merged:     (HEAD detached at 2e84888) debugging-package
Containing: (HEAD detached at 2e84888) emacs-25 master scratch/rest.el
Follows:    emacs-24.5-rc3-fixed (6527)

* lisp/files.el (dir-locals-file): Allow wildcards

(dir-locals-find-file, dir-locals-collect-variables)
(dir-locals-read-from-file): Update accordingly.
(hack-dir-local-variables): Rename a local variable.

* lisp/files-x.el (modify-dir-local-variable): Update accordingly

* lisp/help-fns.el (describe-variable): Update accordingly

* .gitignore: Add .dir-locals?.el

4 files changed, 154 insertions(+), 91 deletions(-)
.gitignore       |   1 +
lisp/files-x.el  |  29 ++++++----
lisp/files.el    | 172 +++++++++++++++++++++++++++++++++++--------------------
lisp/help-fns.el |  43 ++++++++------

modified   .gitignore
@@ -255,6 +255,7 @@ gnustmp*
 ChangeLog
 [0-9]*.patch
 [0-9]*.txt
+.dir-locals?.el
 /vc-dwim-log-*

 # Built by 'make install'.
modified   lisp/files-x.el
@@ -429,18 +429,25 @@ modify-dir-local-variable
   (catch 'exit
     (unless enable-local-variables
       (throw 'exit (message "Directory-local variables are disabled")))
-    (let ((variables-file (or (and (buffer-file-name)
-   (not (file-remote-p (buffer-file-name)))
-   (dir-locals-find-file (buffer-file-name)))
-      dir-locals-file))
+    (let ((variables-file (and (buffer-file-name)
+                               (not (file-remote-p (buffer-file-name)))
+                               (dir-locals-find-file (buffer-file-name))))
   variables)
-      (if (consp variables-file) ; result from cache
-  ;; If cache element has an mtime, assume it came from a file.
-  ;; Otherwise, assume it was set directly.
-  (setq variables-file (if (nth 2 variables-file)
-   (expand-file-name dir-locals-file
-     (car variables-file))
- (cadr variables-file))))
+      (setq variables-file
+            ;; If there are several .dir-locals, the user probably
+            ;; wants to edit the last one (the highest priority).
+            (cond ((stringp variables-file)
+                   (car (last (dir-locals--all-files variables-file))))
+                  ((consp variables-file) ; result from cache
+                   ;; If cache element has an mtime, assume it came
from a file.
+                   ;; Otherwise, assume it was set directly.
+                   (if (nth 2 variables-file)
+                       (car (last (dir-locals--all-files (car
variables-file))))
+                     (cadr variables-file)))
+                  ;; Try to make a proper file-name.  This doesn't cover all
+                  ;; wildcards, but it covers the default value of
`dir-locals-file'.
+                  (t (replace-regexp-in-string
+                      "\\*" "" (replace-regexp-in-string  "\\?" "-"
dir-locals-file)))))
       ;; I can't be bothered to handle this case right now.
       ;; Dir locals were set directly from a class.  You need to
       ;; directly modify the class in dir-locals-class-alist.
modified   lisp/files.el
@@ -3648,7 +3648,7 @@ dir-locals-collect-variables
       (error
        ;; The file's content might be invalid (e.g. have a merge conflict), but
        ;; that shouldn't prevent the user from opening the file.
-       (message ".dir-locals error: %s" (error-message-string err))
+       (message "%s error: %s" dir-locals-file (error-message-string err))
        nil))))

 (defun dir-locals-set-directory-class (directory class &optional mtime)
@@ -3698,11 +3698,38 @@ dir-locals-set-class-variables
   applied by recursively following these rules."
   (setf (alist-get class dir-locals-class-alist) variables))

-(defconst dir-locals-file ".dir-locals.el"
+(defconst dir-locals-file ".dir-locals*.el"
   "File that contains directory-local variables.
 It has to be constant to enforce uniform values
 across different environments and users.")

+(defcustom dir-locals-sort-predicate #'string<
+  "Predicate used to sort dir-locals files before loading them.
+The function should take two arguments (file names) and return
+non-nil if the first argument should be loaded first (which means
+the values in the second file will override those in the first)."
+  :group 'files
+  :type 'function)
+
+(defun dir-locals--all-files (file-or-dir)
+  "Return a list of all readable dir-locals files matching FILE-OR-DIR.
+If FILE-OR-DIR is a file pattern, expand wildcards in it and
+return a sorted list of the results.  If it is a directory name,
+return a sorted list of all files matching `dir-locals-file' in
+this directory."
+  (require 'seq)
+  (let ((default-directory (if (file-directory-p file-or-dir)
+                               file-or-dir
+                             default-directory)))
+    (sort (seq-filter (lambda (f) (and (file-readable-p f)
+                                  (file-regular-p f)))
+                      (file-expand-wildcards
+                       (cond ((not (file-directory-p file-or-dir)) file-or-dir)
+                             ((eq system-type 'ms-dos)
(dosified-file-name dir-locals-file))
+                             (t dir-locals-file))
+                       'full))
+          dir-locals-sort-predicate)))
+
 (defun dir-locals-find-file (file)
   "Find the directory-local variables for FILE.
 This searches upward in the directory tree from FILE.
@@ -3719,75 +3746,96 @@ dir-locals-find-file
 This function returns either nil (no directory local variables found),
 or the matching entry from `dir-locals-directory-cache' (a list),
 or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry."
+of no valid cache entry.  If `dir-locals-file' contains
+wildcards, then the return value is not a proper filename, it is
+an absolute version of `dir-locals-file' which is guaranteed to
+expand to at least one file."
   (setq file (expand-file-name file))
-  (let* ((dir-locals-file-name
-  (if (eq system-type 'ms-dos)
-      (dosified-file-name dir-locals-file)
-    dir-locals-file))
- (locals-file (locate-dominating-file file dir-locals-file-name))
- (dir-elt nil))
+  (let* ((dir-locals-file-name (if (eq system-type 'ms-dos)
+                                   (dosified-file-name dir-locals-file)
+                                 dir-locals-file))
+         (locals-dir (locate-dominating-file
+                      (file-name-directory file)
+                      (lambda (dir)
+                        (let ((default-directory dir))
+                          (file-expand-wildcards dir-locals-file-name
'full)))))
+         locals-file dir-elt)
     ;; `locate-dominating-file' may have abbreviated the name.
-    (and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
- ;; Let dir-locals-read-from-file inform us via demoted-errors
- ;; about unreadable files, etc.
- ;; Maybe we'd want to keep searching though - that is
- ;; a locate-dominating-file issue.
+    (when locals-dir
+      (setq locals-dir (expand-file-name locals-dir))
+      (setq locals-file (expand-file-name dir-locals-file-name locals-dir)))
+    ;; Let dir-locals-read-from-file inform us via demoted-errors
+    ;; about unreadable files, etc.
+    ;; Maybe we'd want to keep searching though - that is
+    ;; a locate-dominating-file issue.
 ;;; (or (not (file-readable-p locals-file))
 ;;;     (not (file-regular-p locals-file)))
 ;;; (setq locals-file nil))
     ;; Find the best cached value in `dir-locals-directory-cache'.
     (dolist (elt dir-locals-directory-cache)
       (when (and (string-prefix-p (car elt) file
-  (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
+                                  (memq system-type
+                                        '(windows-nt cygwin ms-dos)))
+                 (> (length (car elt)) (length (car dir-elt))))
+        (setq dir-elt elt)))
     (if (and dir-elt
-     (or (null locals-file)
- (<= (length (file-name-directory locals-file))
-     (length (car dir-elt)))))
- ;; Found a potential cache entry.  Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-file (expand-file-name dir-locals-file-name
-     (car dir-elt))))
-  (and (file-readable-p cached-file)
-       (equal (nth 2 dir-elt)
-      (nth 5 (file-attributes cached-file))))))
-    ;; This cache entry is OK.
-    dir-elt
-  ;; This cache entry is invalid; clear it.
-  (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
-  ;; Return the first existing dir-locals file.  Might be the same
-  ;; as dir-elt's, might not (eg latter might have been deleted).
-  locals-file)
+             (or (null locals-dir)
+                 (<= (length locals-dir)
+                     (length (car dir-elt)))))
+        ;; Found a potential cache entry.  Check validity.
+        ;; A cache entry with no MTIME is assumed to always be valid
+        ;; (ie, set directly, not from a dir-locals file).
+        ;; Note, we don't bother to check that there is a matching class
+        ;; element in dir-locals-class-alist, since that's done by
+        ;; dir-locals-set-directory-class.
+        (if (or (null (nth 2 dir-elt))
+                (let ((cached-files (dir-locals--all-files (car dir-elt))))
+                  ;; The entry MTIME should match the most recent
+                  ;; MTIME among matching files.
+                  (and cached-files
+                       (= (time-to-seconds (nth 2 dir-elt))
+                          (apply #'max (mapcar (lambda (f)
(time-to-seconds (nth 5 (file-attributes f))))
+                                               cached-files))))))
+            ;; This cache entry is OK.
+            dir-elt
+          ;; This cache entry is invalid; clear it.
+          (setq dir-locals-directory-cache
+                (delq dir-elt dir-locals-directory-cache))
+          ;; Return the first existing dir-locals file.  Might be the same
+          ;; as dir-elt's, might not (eg latter might have been deleted).
+          locals-file)
       ;; No cache entry.
       locals-file)))

 (defun dir-locals-read-from-file (file)
   "Load a variables FILE and register a new class and instance.
-FILE is the name of the file holding the variables to apply.
+FILE is the absolute name of the file holding the variables to
+apply.  It may contain wildcards.
 The new class name is the same as the directory in which FILE
 is found.  Returns the new class name."
-  (with-temp-buffer
+  (require 'map)
+  (let* ((dir-name (file-name-directory file))
+         (class-name (intern dir-name))
+         (files (dir-locals--all-files file))
+         (read-circle nil)
+         (variables))
     (with-demoted-errors "Error reading dir-locals: %S"
-      (insert-file-contents file)
-      (unless (zerop (buffer-size))
-        (let* ((dir-name (file-name-directory file))
-               (class-name (intern dir-name))
-               (variables (let ((read-circle nil))
-                            (read (current-buffer)))))
-          (dir-locals-set-class-variables class-name variables)
-          (dir-locals-set-directory-class dir-name class-name
-                                          (nth 5 (file-attributes file)))
-          class-name)))))
+      (dolist (file files)
+        (with-temp-buffer
+          (insert-file-contents file)
+          (condition-case-unless-debug nil
+              (setq variables
+                    (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
+                                    variables
+                                    (read (current-buffer))))
+            (end-of-file nil)))))
+    (dir-locals-set-class-variables class-name variables)
+    (dir-locals-set-directory-class
+     dir-name class-name
+     (seconds-to-time (apply #'max (mapcar (lambda (file)
+                                             (time-to-seconds (nth 5
(file-attributes file))))
+                                           files))))
+    class-name))

 (defcustom enable-remote-dir-locals nil
   "Non-nil means dir-local variables will be applied to remote files."
@@ -3810,17 +3858,17 @@ hack-dir-local-variables
  (not (file-remote-p (or (buffer-file-name)
  default-directory)))))
     ;; Find the variables file.
-    (let ((variables-file (dir-locals-find-file
-                           (or (buffer-file-name) default-directory)))
+    (let ((file-pattern-or-cache (dir-locals-find-file
+                                  (or (buffer-file-name) default-directory)))
   (class nil)
   (dir-name nil))
       (cond
-       ((stringp variables-file)
- (setq dir-name (file-name-directory variables-file)
-      class (dir-locals-read-from-file variables-file)))
-       ((consp variables-file)
- (setq dir-name (nth 0 variables-file))
- (setq class (nth 1 variables-file))))
+       ((stringp file-pattern-or-cache)
+ (setq dir-name (file-name-directory file-pattern-or-cache)
+      class (dir-locals-read-from-file file-pattern-or-cache)))
+       ((consp file-pattern-or-cache)
+ (setq dir-name (nth 0 file-pattern-or-cache))
+ (setq class (nth 1 file-pattern-or-cache))))
       (when class
  (let ((variables
        (dir-locals-collect-variables
modified   lisp/help-fns.el
@@ -907,29 +907,36 @@ describe-variable
                                             (buffer-file-name buffer)))
                                       (dir-locals-find-file
                                        (buffer-file-name buffer))))
-                          (dir-file t))
+                          (is-directory nil))
       (princ (substitute-command-keys
       "  This variable's value is directory-local"))
-      (if (null file)
-  (princ ".\n")
- (princ ", set ")
-                        (if (consp file) ; result from cache
-                            ;; If the cache element has an mtime, we
-                            ;; assume it came from a file.
-                            (if (nth 2 file)
-                                (setq file (expand-file-name
-                                            dir-locals-file (car file)))
-                              ;; Otherwise, assume it was set directly.
-                              (setq file (car file)
-                                    dir-file nil)))
- (princ (substitute-command-keys
-                                (if dir-file
-                                    "by the file\n  `"
-                                  "for the directory\n  `")))
+                      (when (consp file) ; result from cache
+                        ;; If the cache element has an mtime, we
+                        ;; assume it came from a file.
+                        (if (nth 2 file)
+                            (setq file (expand-file-name
+                                        dir-locals-file (car file)))
+                          ;; Otherwise, assume it was set directly.
+                          (setq file (car file)
+                                is-directory t)))
+                      (if (null file)
+                          (princ ".\n")
+                        (princ ", set ")
+                        (let ((files (file-expand-wildcards file)))
+                          (princ (substitute-command-keys
+                                  (cond
+                                   (is-directory "for the directory\n  `")
+                                   ;; Many files matched.
+                                   ((cdr files)
+                                    (setq file (file-name-directory
(car files)))
+                                    (format "by a file\n  matching
`%s' in the directory\n  `"
+                                            dir-locals-file))
+                                   (t (setq file (car files))
+                                      "by the file\n  `"))))
  (with-current-buffer standard-output
   (insert-text-button
    file 'type 'help-dir-local-var-def
-   'help-args (list variable file)))
+                             'help-args (list variable file))))
  (princ (substitute-command-keys "'.\n"))))
   (princ (substitute-command-keys
   "  This variable's value is file-local.\n"))))