From d647fd713b0a9e2b1b1bcacfa9546da9ce23c690 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sat, 4 Sep 2021 16:25:22 +0200 Subject: [PATCH 06/10] gexp: Allow overriding the absolute file name. This will be used by the next patch to implement search-patch in terms of local-file. * guix/gexp.scm (precanonicalized-file-name): New macro. (local-file): Use the absolute file name from precanonicalized-file-name when available. --- guix/gexp.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index a633984688..c69e4aa299 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -51,6 +51,7 @@ gexp-input-output gexp-input-native? + precanonicalized-file-name assume-valid-file-name local-file local-file? @@ -463,6 +464,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 (precanonicalized-file-name file absolute) + "This is a syntactic keyword to tell 'local-file' that it can assume that +the given file name FILE has ABSOLUTE as absolute file name and 'local-file' +does not need to compute the absolute file name by itself." + absolute) + (define-syntax local-file (lambda (s) "Return an object representing local file FILE to add to the store; this @@ -481,7 +488,7 @@ 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 precanonicalized-file-name) ((_ file rest ...) (string? (syntax->datum #'file)) ;; FILE is a literal, so resolve it relative to the source directory. @@ -495,6 +502,9 @@ appears." #'(%local-file file (delay (absolute-file-name file (getcwd))) rest ...)) + ((_ (precanonicalized-file-name file absolute) rest ...) + ;; Use the given file name ABSOLUTE as absolute file name. + #'(%local-file file (delay absolute) rest ...)) ((_ file rest ...) ;; Resolve FILE relative to the current directory. (with-syntax ((location (datum->syntax s (syntax-source s)))) -- 2.33.0