diff options
Diffstat (limited to 'build-aux')
| -rw-r--r-- | build-aux/compile-all.scm | 92 |
1 files changed, 12 insertions, 80 deletions
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 <http://www.gnu.org/licenses/>. -(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-mtime<? go file)))) -(define (file->module file) - (let* ((relative (relative-file file)) - (module-path (string-drop-right relative 4))) - (map string->symbol - (string-split module-path #\/)))) - -;;; To work around <http://bugs.gnu.org/15602> (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))))))) |