From 2890ad332fcdfd4bc92b127d783975437c8b718b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 13 Oct 2017 18:07:41 +0200 Subject: build: Factorize module compilation in (guix build compile). * guix/build/compile.scm: New file. * Makefile.am (MODULES): Add it. * build-aux/compile-all.scm: Use it. (warnings, file->module, load-module-file) (%default-optimizations, %lightweight-optimizations) (optimization-options, compile-file*): Remove. : Use 'compile-files'. * guix/build/pull.scm (%default-optimizations) (%lightweight-optimizations, optimization-options): Remove. (build-guix): Rewrite as a call to 'compile-files'. * guix/discovery.scm (file-name->module-name): Export. --- build-aux/compile-all.scm | 92 +++++++---------------------------------------- 1 file changed, 12 insertions(+), 80 deletions(-) (limited to 'build-aux') diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm index fe25c5d065..2fc3102daa 100644 --- a/build-aux/compile-all.scm +++ b/build-aux/compile-all.scm @@ -17,21 +17,12 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(use-modules (system base target) - (system base message) - (ice-9 match) +(use-modules (ice-9 match) (ice-9 threads) + (guix build compile) (guix build utils)) -(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 host (getenv "host")) - (define srcdir (getenv "srcdir")) (define (relative-file file) @@ -53,62 +44,6 @@ (or (not (file-exists? go)) (file-mtimemodule file) - (let* ((relative (relative-file file)) - (module-path (string-drop-right relative 4))) - (map string->symbol - (string-split module-path #\/)))) - -;;; To work around (FIXME), we want to load all -;;; files to be compiled first. We do this via resolve-interface so that the -;;; top-level of each file (module) is only executed once. -(define (load-module-file file) - (let ((module (file->module file))) - (format #t " LOAD ~a~%" module) - (resolve-interface module))) - -(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 (compile-file* file output-mutex) - (let ((go (scm->go file))) - (with-mutex output-mutex - (format #t " GUILEC ~a~%" go) - (force-output)) - (mkdir-p (dirname go)) - (with-fluids ((*current-warning-prefix* "")) - (with-target host - (lambda () - (compile-file file - #:output-file go - #:opts `(#:warnings ,warnings - ,@(optimization-options file)))))))) - ;; Install a SIGINT handler to give unwind handlers in 'compile-file' an ;; opportunity to run upon SIGINT and to remove temporary output files. (sigaction SIGINT @@ -117,16 +52,13 @@ (match (command-line) ((_ . files) - (let ((files (filter file-needs-compilation? files))) - (for-each load-module-file files) - (let ((mutex (make-mutex))) - ;; Make sure compilation related modules are loaded before starting to - ;; compile files in parallel. - (compile #f) - (par-for-each (lambda (file) - (compile-file* file mutex)) - files))))) - -;;; Local Variables: -;;; eval: (put 'with-target 'scheme-indent-function 1) -;;; End: + (compile-files srcdir (getcwd) + (filter file-needs-compilation? files) + #:host host + #:report-load (lambda (file total completed) + (when file + (format #t " LOAD ~a~%" file))) + #:report-compilation (lambda (file total completed) + (when file + (format #t " GUILEC ~a~%" + (scm->go file))))))) -- cgit v1.2.3