summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-10-16 14:55:00 +0200
committerLudovic Courtès <ludo@gnu.org>2020-10-16 15:00:50 +0200
commit5d4ad8e1be6d60c38577e2f3d92cc5642b12eff0 (patch)
treebc1f508d5c78c60f48a3b7def440c1b2a4777d23
parente39e8d97c17c7e7a008a4f4e125ae6b3844cc03a (diff)
gexp: Add 'assume-valid-file-name' syntax for use with 'local-file'.
* guix/gexp.scm (assume-valid-file-name): New variable. (local-file): Add clause with (assume-valid-file-name file).
-rw-r--r--guix/gexp.scm18
1 files changed, 16 insertions, 2 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 25e4881d21..76fffc4908 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -48,6 +48,7 @@
gexp-input-output
gexp-input-native?
+ assume-valid-file-name
local-file
local-file?
local-file-file
@@ -424,6 +425,12 @@ vicinity of DIRECTORY."
(string-append directory "/" file))
(else file))))
+(define-syntax-rule (assume-valid-file-name file)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file name is valid, even if it's not a string literal, and thus not
+warn about it."
+ file)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -442,13 +449,20 @@ 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 ()
+ (syntax-case s (assume-valid-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-valid-file-name file) rest ...)
+ ;; FILE is not a literal, so resolve it relative to the source
+ ;; directory. Since the user declared FILE is valid, do not pass
+ ;; #:literal? #f so that we do not warn about it later on.
+ #'(%local-file file
+ (delay (absolute-file-name file (current-source-directory)))
+ rest ...))
((_ file rest ...)
;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s))))
@@ -456,7 +470,7 @@ appears."
(delay (absolute-file-name file (getcwd)))
rest ...
#:location 'location
- #:literal? #f)))
+ #:literal? #f))) ;warn if FILE is relative
((_)
#'(syntax-error "missing file name"))
(id