~ruther/guix-local

07c8a98c3b45dca9fd36af7c4a300d3af58734dd — Ludovic Courtès 10 years ago b789974
gexp: Move 'current-source-directory' to (guix utils).

* guix/gexp.scm (extract-directory, current-source-directory): Move to...
* guix/utils.scm (extract-directory, current-source-directory):
... here.  New procedures.
2 files changed, 15 insertions(+), 13 deletions(-)

M guix/gexp.scm
M guix/utils.scm
M guix/gexp.scm => guix/gexp.scm +0 -13
@@ 202,19 202,6 @@ cross-compiling.)"
  ;; %%LOCAL-FILE is not.
  (%%local-file file promise name recursive?))

(define (extract-directory properties)
  "Extract the directory name from source location PROPERTIES."
  (match (assq 'filename properties)
    (('filename . (? string? file-name))
     (dirname file-name))
    (_
     #f)))

(define-syntax-rule (current-source-directory)
  "Expand to the directory of the current source file or #f if it could not
be determined."
  (extract-directory (current-source-location)))

(define (absolute-file-name file directory)
  "Return the canonical absolute file name for FILE, which lives in the
vicinity of DIRECTORY."

M guix/utils.scm => guix/utils.scm +15 -0
@@ 53,6 53,8 @@
            substitute-keyword-arguments
            ensure-keyword-arguments

            current-source-directory

            <location>
            location
            location?


@@ 700,6 702,19 @@ output port, and PROC's result is returned."
;;; Source location.
;;;

(define (extract-directory properties)
  "Extract the directory name from source location PROPERTIES."
  (match (assq 'filename properties)
    (('filename . (? string? file-name))
     (dirname file-name))
    (_
     #f)))

(define-syntax-rule (current-source-directory)
  "Expand to the directory of the current source file or #f if it could not
be determined."
  (extract-directory (current-source-location)))

;; A source location.
(define-record-type <location>
  (make-location file line column)