02/03: utils: Memoize 'absolute-dirname'.

[Ludovic Court�s]

civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.

commit 024d6d5e349e84f0aacaa67551963ee4b255969e
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jun 26 17:48:28 2017 +0200

    utils: Memoize 'absolute-dirname'.
    
    * guix/utils.scm (absolute-dirname): Wrap in 'mlambda'.
---
 guix/utils.scm | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index 9bf1cc8..90e9c66 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -666,17 +666,19 @@ output port, and PROC's result is returned."
 ;;; Source location.
 ;;;
 
-(define (absolute-dirname file)
-  "Return the absolute name of the directory containing FILE, or #f upon
+(define absolute-dirname
+  ;; Memoize to avoid repeated 'stat' storms from 'search-path'.
+  (mlambda (file)
+    "Return the absolute name of the directory containing FILE, or #f upon
 failure."
-  (match (search-path %load-path file)
-    (#f #f)
-    ((? string? file)
-     ;; If there are relative names in %LOAD-PATH, FILE can be relative and
-     ;; needs to be canonicalized.
-     (if (string-prefix? "/" file)
-         (dirname file)
-         (canonicalize-path (dirname file))))))
+    (match (search-path %load-path file)
+      (#f #f)
+      ((? string? file)
+       ;; If there are relative names in %LOAD-PATH, FILE can be relative and
+       ;; needs to be canonicalized.
+       (if (string-prefix? "/" file)
+           (dirname file)
+           (canonicalize-path (dirname file)))))))
 
 (define-syntax current-source-directory
   (lambda (s)