diff options
| author | Marius Bakke <mbakke@fastmail.com> | 2017-11-19 15:01:00 +0100 |
|---|---|---|
| committer | Marius Bakke <mbakke@fastmail.com> | 2017-11-19 15:01:00 +0100 |
| commit | 2dd12924cf4a30a96262b6d392fcde58c9f10d4b (patch) | |
| tree | 3f74f5426ff214a02b8f6652f6516979657a7f98 /guix/build/compile.scm | |
| parent | 259b4f34ba2eaefeafdb7c9f9eb56ee77f16010c (diff) | |
| parent | a93447b89a5b132221072e729d13a3f17391b8c2 (diff) | |
| download | gnu-guix-2dd12924cf4a30a96262b6d392fcde58c9f10d4b.tar gnu-guix-2dd12924cf4a30a96262b6d392fcde58c9f10d4b.tar.gz | |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build/compile.scm')
| -rw-r--r-- | guix/build/compile.scm | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/guix/build/compile.scm b/guix/build/compile.scm index ea0c36fa33..8b5a2faf84 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -77,6 +77,12 @@ "Strip the \".scm\" suffix from FILE, and append \".go\"." (string-append (string-drop-right file 4) ".go")) +(define (relative-file directory file) + "Return FILE relative to DIRECTORY, if possible." + (if (string-prefix? (string-append directory "/") file) + (string-drop file (+ 1 (string-length directory))) + file)) + (define* (load-files directory files #:key (report-load (const #f)) @@ -93,13 +99,14 @@ (report-load #f total completed)) *unspecified*) ((file files ...) - (report-load file total completed) - (format debug-port "~%loading '~a'...~%" file) + (let ((file (relative-file directory file))) + (report-load file total completed) + (format debug-port "~%loading '~a'...~%" file) - (parameterize ((current-warning-port debug-port)) - (resolve-interface (file-name->module-name file))) + (parameterize ((current-warning-port debug-port)) + (resolve-interface (file-name->module-name file))) - (loop files (+ 1 completed)))))) + (loop files (+ 1 completed))))))) (define-syntax-rule (with-augmented-search-path path item body ...) "Within the dynamic extent of BODY, augment PATH by adding ITEM to the @@ -135,11 +142,12 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"." (with-fluids ((*current-warning-prefix* "")) (with-target host (lambda () - (compile-file file - #:output-file (string-append build-directory "/" - (scm->go file)) - #:opts (append warning-options - (optimization-options file)))))) + (let ((relative (relative-file source-directory file))) + (compile-file file + #:output-file (string-append build-directory "/" + (scm->go relative)) + #:opts (append warning-options + (optimization-options relative))))))) (with-mutex progress-lock (set! completed (+ 1 completed)))) |