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:
Richard Sent 2024-06-02 15:44:27 -04:00 committed by Ludovic Courtès
parent 8da7f4a110
commit f3ea876895
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 25 additions and 1 deletions

View File

@ -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

View File

@ -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

View File

@ -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)))