gexp: Add ‘assume-source-relative-file-name’.
* guix/gexp.scm (assume-source-relative-file-name): New macro. (local-file): Use assume-source-relative-file-name to look up a non-literal file relative to the current source directory. * doc/guix.texi (G-expressions): Document it. * tests/gexp.scm ("local-file, non-literal source relative file name"): New test. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Change-Id: I18573c8c7a6c87e8351b34412f9d26bb23b068b4
This commit is contained in:
parent
8da7f4a110
commit
f3ea876895
@ -12251,6 +12251,11 @@ Wrapping is done like this:
|
||||
(local-file (assume-valid-file-name alice-key-file-path))
|
||||
@end lisp
|
||||
|
||||
@var{file} can be wrapped in the @code{assume-source-relative-file-name}
|
||||
syntactic keyword. When this is done, the file name will be looked up
|
||||
relative to the source file where it appears even when it is not a
|
||||
string literal.
|
||||
|
||||
This is the declarative counterpart of the @code{interned-file} monadic
|
||||
procedure (@pxref{The Store Monad, @code{interned-file}}).
|
||||
@end deffn
|
||||
|
@ -52,6 +52,7 @@
|
||||
gexp-input-native?
|
||||
|
||||
assume-valid-file-name
|
||||
assume-source-relative-file-name
|
||||
local-file
|
||||
local-file?
|
||||
local-file-file
|
||||
@ -485,6 +486,12 @@ the given file name is valid, even if it's not a string literal, and thus not
|
||||
warn about it."
|
||||
file)
|
||||
|
||||
(define-syntax-rule (assume-source-relative-file-name file)
|
||||
"This is a syntactic keyword to tell 'local-file' that it can assume that
|
||||
the given file is relative to the source directory, even if it's not a string
|
||||
literal."
|
||||
file)
|
||||
|
||||
(define-syntax local-file
|
||||
(lambda (s)
|
||||
"Return an object representing local file FILE to add to the store; this
|
||||
@ -503,13 +510,19 @@ where FILE is the entry's absolute file name and STAT is the result of
|
||||
This is the declarative counterpart of the 'interned-file' monadic procedure.
|
||||
It is implemented as a macro to capture the current source directory where it
|
||||
appears."
|
||||
(syntax-case s (assume-valid-file-name)
|
||||
(syntax-case s (assume-valid-file-name assume-source-relative-file-name)
|
||||
((_ file rest ...)
|
||||
(string? (syntax->datum #'file))
|
||||
;; FILE is a literal, so resolve it relative to the source directory.
|
||||
#'(%local-file file
|
||||
(delay (absolute-file-name file (current-source-directory)))
|
||||
rest ...))
|
||||
((_ (assume-source-relative-file-name file) rest ...)
|
||||
;; FILE is not a literal, but the user requested we look it up
|
||||
;; relative to the current source directory.
|
||||
#'(%local-file file
|
||||
(delay (absolute-file-name file (current-source-directory)))
|
||||
rest ...))
|
||||
((_ (assume-valid-file-name file) rest ...)
|
||||
;; FILE is not a literal, so resolve it relative to the current
|
||||
;; directory. Since the user declared FILE is valid, do not pass
|
||||
|
@ -251,6 +251,12 @@
|
||||
(let ((file (local-file (string-copy "../base32.scm"))))
|
||||
(local-file-absolute-file-name file)))))
|
||||
|
||||
(test-equal "local-file, non-literal source relative file name"
|
||||
(current-filename)
|
||||
(let ((file (local-file (assume-source-relative-file-name
|
||||
(string-append "gexp" ".scm")))))
|
||||
(local-file-absolute-file-name file)))
|
||||
|
||||
(test-assert "local-file, relative file name, within gexp"
|
||||
(let* ((file (search-path %load-path "guix/base32.scm"))
|
||||
(interned (add-to-store %store "base32.scm" #f "sha256" file)))
|
||||
|
Loading…
Reference in New Issue
Block a user