From 2890ad332fcdfd4bc92b127d783975437c8b718b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès 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 1.4.1 From 3a9976bfcd13e6554a2458ce1a3b9d7b95043195 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Oct 2017 18:21:47 +0200 Subject: build: Honor make's '-j' flag. * build-aux/compile-all.scm (parallel-job-count): New procedure. : Pass it to 'compile-files' as #:workers. --- build-aux/compile-all.scm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) (limited to 'build-aux') diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm index 2fc3102daa..c7ca5a6f67 100644 --- a/build-aux/compile-all.scm +++ b/build-aux/compile-all.scm @@ -19,6 +19,7 @@ (use-modules (ice-9 match) (ice-9 threads) + (srfi srfi-1) (guix build compile) (guix build utils)) @@ -44,6 +45,39 @@ (or (not (file-exists? go)) (file-mtimenumber count) _ ...) + (if (integer? count) + count + (current-processor-count))) + ((head tail ...) + (if (string-prefix? "-j" head) + (match (string-drop head 2) + ("" + (current-processor-count)) + ((= string->number count) + (if (integer? count) + count + (current-processor-count)))) + (loop tail))))))))) + ;; 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 @@ -54,6 +88,7 @@ ((_ . files) (compile-files srcdir (getcwd) (filter file-needs-compilation? files) + #:workers (parallel-job-count) #:host host #:report-load (lambda (file total completed) (when file -- cgit 1.4.1 From ce33c3af76b0e5c68cc42dddf2b9c4b017386fd8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Oct 2017 16:33:50 -0700 Subject: pull: Add (guix build compile) to the mix. Fixes . Reported by Leo Famulari . * build-aux/build-self.scm (build): Add (guix build compile) to #:modules. * guix/build/pull.scm (build-guix): Wrap 'compile-files' call in 'with-directory-excursion'. Strip "./" from FILES when passing it to 'compile-files'. --- build-aux/build-self.scm | 1 + guix/build/pull.scm | 59 ++++++++++++++++++++++++++++-------------------- 2 files changed, 35 insertions(+), 25 deletions(-) (limited to 'build-aux') diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 4933e02712..ed8ff5f4ce 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -245,6 +245,7 @@ Please upgrade to an intermediate version first, for instance with: (gexp->derivation "guix-latest" builder #:modules '((guix build pull) (guix build utils) + (guix build compile) ;; Closure of (guix modules). (guix modules) diff --git a/guix/build/pull.scm b/guix/build/pull.scm index 6f7aa27868..588b5feddf 100644 --- a/guix/build/pull.scm +++ b/guix/build/pull.scm @@ -121,31 +121,40 @@ containing the source code. Write any debugging output to DEBUG-PORT." ;; Compile the .scm files. Filter out files depending on Guile-SSH when ;; Guile-SSH is missing. - (let ((files (filter has-all-its-dependencies? - (all-scheme-files out)))) - (compile-files out out 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))))) + (with-directory-excursion out + (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) -- cgit 1.4.1