~ruther/guix-local

cbbbb7be0fbaa11ff75bce92f2d82131ff8db104 — Ludovic Courtès 9 years ago 95fa173
utils: 'current-source-directory' resolves relative file names at run time.

* guix/utils.scm (absolute-dirname): New procedure.
(current-source-directory): Emit code to use it instead of calling
'search-path'.
1 files changed, 17 insertions(+), 3 deletions(-)

M guix/utils.scm
M guix/utils.scm => guix/utils.scm +17 -3
@@ 702,6 702,18 @@ 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
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))))))

(define-syntax current-source-directory
  (lambda (s)
    "Return the absolute name of the current directory, or #f if it could not


@@ 711,11 723,13 @@ be determined."
       (match (assq 'filename (syntax-source s))
         (('filename . (? string? file-name))
          ;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME
          ;; can be relative.  In that case, we try to find out the absolute
          ;; file name by looking at %LOAD-PATH.
          ;; can be relative.  In that case, we try to find out at run time
          ;; the absolute file name by looking at %LOAD-PATH; doing this at
          ;; run time rather than expansion time is necessary to allow files
          ;; to be moved on the file system.
          (if (string-prefix? "/" file-name)
              (dirname file-name)
              (and=> (search-path %load-path file-name) dirname)))
              #`(absolute-dirname #,file-name)))
         (_
          #f))))))