aboutsummaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/compile.scm165
-rw-r--r--guix/build/go-build-system.scm10
-rw-r--r--guix/build/pull.scm115
3 files changed, 210 insertions, 80 deletions
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
new file mode 100644
index 0000000000..ea0c36fa33
--- /dev/null
+++ b/guix/build/compile.scm
@@ -0,0 +1,165 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build compile)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 threads)
+ #:use-module (system base target)
+ #:use-module (system base compile)
+ #:use-module (system base message)
+ #:use-module (guix modules)
+ #:use-module (guix build utils)
+ #:export (%default-optimizations
+ %lightweight-optimizations
+ compile-files))
+
+;;; Commentary:
+;;;
+;;; Support code to compile Guile code as efficiently as possible (both with
+;;; Guile 2.0 and 2.2).
+;;;
+;;; Code:
+
+(cond-expand
+ (guile-2.2 (use-modules (language tree-il optimize)
+ (language cps optimize)))
+ (else #f))
+
+(define %default-optimizations
+ ;; Default optimization options (equivalent to -O2 on Guile 2.2).
+ (cond-expand
+ (guile-2.2 (append (tree-il-default-optimization-options)
+ (cps-default-optimization-options)))
+ (else '())))
+
+(define %lightweight-optimizations
+ ;; Lightweight optimizations (like -O0, but with partial evaluation).
+ (let loop ((opts %default-optimizations)
+ (result '()))
+ (match opts
+ (() (reverse result))
+ ((#:partial-eval? _ rest ...)
+ (loop rest `(#t #:partial-eval? ,@result)))
+ ((kw _ rest ...)
+ (loop rest `(#f ,kw ,@result))))))
+
+(define %warnings
+ ;; FIXME: 'format' is missing because it reports "non-literal format
+ ;; strings" due to the fact that we use 'G_' instead of '_'. We'll need
+ ;; help from Guile to solve this.
+ '(unsupported-warning unbound-variable arity-mismatch
+ macro-use-before-definition)) ;new in 2.2
+
+(define (optimization-options file)
+ "Return the default set of optimizations options for FILE."
+ (if (string-contains file "gnu/packages/")
+ %lightweight-optimizations ;build faster
+ '()))
+
+(define (scm->go file)
+ "Strip the \".scm\" suffix from FILE, and append \".go\"."
+ (string-append (string-drop-right file 4) ".go"))
+
+(define* (load-files directory files
+ #:key
+ (report-load (const #f))
+ (debug-port (%make-void-port "w")))
+ "Load FILES, a list of relative file names, from DIRECTORY."
+ (define total
+ (length files))
+
+ (let loop ((files files)
+ (completed 0))
+ (match files
+ (()
+ (unless (zero? total)
+ (report-load #f total completed))
+ *unspecified*)
+ ((file files ...)
+ (report-load file total completed)
+ (format debug-port "~%loading '~a'...~%" file)
+
+ (parameterize ((current-warning-port debug-port))
+ (resolve-interface (file-name->module-name file)))
+
+ (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
+front."
+ (let ((initial-value path))
+ (dynamic-wind
+ (lambda ()
+ (set! path (cons item path)))
+ (lambda ()
+ body ...)
+ (lambda ()
+ (set! path initial-value)))))
+
+(define* (compile-files source-directory build-directory files
+ #:key
+ (host %host-type)
+ (workers (current-processor-count))
+ (optimization-options optimization-options)
+ (warning-options `(#:warnings ,%warnings))
+ (report-load (const #f))
+ (report-compilation (const #f))
+ (debug-port (%make-void-port "w")))
+ "Compile FILES, a list of source files taken from SOURCE-DIRECTORY, to
+BUILD-DIRECTORY, using up to WORKERS parallel workers. The resulting object
+files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
+ (define progress-lock (make-mutex))
+ (define total (length files))
+ (define completed 0)
+
+ (define (build file)
+ (with-mutex progress-lock
+ (report-compilation file total completed))
+ (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))))))
+ (with-mutex progress-lock
+ (set! completed (+ 1 completed))))
+
+ (with-augmented-search-path %load-path source-directory
+ (with-augmented-search-path %load-compiled-path build-directory
+ ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
+ ;; of FILES.
+ (load-files source-directory files
+ #:report-load report-load
+ #:debug-port debug-port)
+
+ ;; Make sure compilation related modules are loaded before starting to
+ ;; compile files in parallel.
+ (compile #f)
+
+ (n-par-for-each workers build files)
+ (unless (zero? total)
+ (report-compilation #f total total)))))
+
+;;; Local Variables:
+;;; eval: (put 'with-augmented-search-path 'scheme-indent-function 2)
+;;; eval: (put 'with-target 'scheme-indent-function 1)
+;;; End:
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 7f04e3db8c..72af6ce7b6 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -126,13 +126,14 @@ unset. When SOURCE is a directory, copy it instead of unpacking."
(zero? (system* "unzip" "-d" dest source))
(zero? (system* "tar" "-C" dest "-xvf" source))))))
-(define* (install-source #:key outputs #:allow-other-keys)
+(define* (install-source #:key install-source? outputs #:allow-other-keys)
"Install the source code to the output directory."
(let* ((out (assoc-ref outputs "out"))
(source "src")
(dest (string-append out "/" source)))
- (copy-recursively source dest #:keep-mtime? #t)
- #t))
+ (if install-source?
+ (copy-recursively source dest #:keep-mtime? #t)
+ #t)))
(define (go-package? name)
(string-prefix? "go-" name))
@@ -179,6 +180,9 @@ respectively."
(zero? (system* "go" "install"
"-v" ; print the name of packages as they are compiled
"-x" ; print each command as it is invoked
+ ;; Respectively, strip the symbol table and debug
+ ;; information, and the DWARF symbol table.
+ "-ldflags=-s -w"
import-path))
(begin
(display (string-append "Building '" import-path "' failed.\n"
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 1ae35ab382..3573241a7e 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -20,11 +20,10 @@
(define-module (guix build pull)
#:use-module (guix modules)
#:use-module (guix build utils)
- #:use-module (system base compile)
+ #:use-module (guix build compile)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
- #:use-module (ice-9 threads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -63,34 +62,6 @@ available, false otherwise."
(string-prefix? gnu b))
(string<? a b))))))
-(cond-expand
- (guile-2.2 (use-modules (language tree-il optimize)
- (language cps optimize)))
- (else #f))
-
-(define %default-optimizations
- ;; Default optimization options (equivalent to -O2 on Guile 2.2).
- (cond-expand
- (guile-2.2 (append (tree-il-default-optimization-options)
- (cps-default-optimization-options)))
- (else '())))
-
-(define %lightweight-optimizations
- ;; Lightweight optimizations (like -O0, but with partial evaluation).
- (let loop ((opts %default-optimizations)
- (result '()))
- (match opts
- (() (reverse result))
- ((#:partial-eval? _ rest ...)
- (loop rest `(#t #:partial-eval? ,@result)))
- ((kw _ rest ...)
- (loop rest `(#f ,kw ,@result))))))
-
-(define (optimization-options file)
- (if (string-contains file "gnu/packages/")
- %lightweight-optimizations ;build faster
- '()))
-
(define* (build-guix out source
#:key
@@ -148,53 +119,43 @@ containing the source code. Write any debugging output to DEBUG-PORT."
(set! %load-path (cons out %load-path))
(set! %load-compiled-path (cons out %load-compiled-path))
- ;; Compile the .scm files. Load all the files before compiling them to
- ;; work around <http://bugs.gnu.org/15602> (FIXME).
- ;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
- (let* ((files (filter has-all-its-dependencies?
- (all-scheme-files out)))
- (total (length files)))
- (let loop ((files files)
- (completed 0))
- (match files
- (() *unspecified*)
- ((file . files)
- (display #\cr log-port)
- (format log-port "loading...\t~5,1f% of ~d files" ;FIXME: i18n
- (* 100. (/ completed total)) total)
- (force-output log-port)
- (format debug-port "~%loading '~a'...~%" file)
- ;; Turn "<out>/foo/bar.scm" into (foo bar).
- (let* ((relative-file (string-drop file (+ (string-length out) 1)))
- (module-path (string-drop-right relative-file 4))
- (module-name (map string->symbol
- (string-split module-path #\/))))
- (parameterize ((current-warning-port debug-port))
- (resolve-interface module-name)))
- (loop files (+ 1 completed)))))
- (newline)
- (let ((mutex (make-mutex))
- (completed 0))
- ;; Make sure compilation related modules are loaded before starting to
- ;; compile files in parallel.
- (compile #f)
- (n-par-for-each
- (parallel-job-count)
- (lambda (file)
- (with-mutex mutex
- (display #\cr log-port)
- (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
- (* 100. (/ completed total)) total)
- (force-output log-port)
- (format debug-port "~%compiling '~a'...~%" file))
- (let ((go (string-append (string-drop-right file 4) ".go")))
- (parameterize ((current-warning-port (%make-void-port "w")))
- (compile-file file
- #:output-file go
- #:opts (optimization-options file))))
- (with-mutex mutex
- (set! completed (+ 1 completed))))
- files))))
+ ;; Compile the .scm files. Hide warnings.
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (with-directory-excursion out
+ ;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
+ (let ((files (filter has-all-its-dependencies?
+ (all-scheme-files "."))))
+ (compile-files out out
+
+ ;; XXX: 'compile-files' except ready-to-use relative
+ ;; file names.
+ (map (lambda (file)
+ (if (string-prefix? "./" file)
+ (string-drop file 2)
+ file))
+ files)
+
+ #:workers (parallel-job-count)
+
+ ;; Disable warnings.
+ #:warning-options '()
+
+ #:report-load
+ (lambda (file total completed)
+ (display #\cr log-port)
+ (format log-port
+ "loading...\t~5,1f% of ~d files" ;FIXME: i18n
+ (* 100. (/ completed total)) total)
+ (force-output log-port)
+ (format debug-port "~%loading '~a'...~%" file))
+
+ #:report-compilation
+ (lambda (file total completed)
+ (display #\cr log-port)
+ (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+ (* 100. (/ completed total)) total)
+ (force-output log-port)
+ (format debug-port "~%compiling '~a'...~%" file)))))))
(newline)
#t)
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-23 23:16:37 +0000