aboutsummaryrefslogtreecommitdiff
path: root/build-aux/compile-all.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-13 18:07:41 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-22 22:09:00 -0700
commit2890ad332fcdfd4bc92b127d783975437c8b718b (patch)
treeaefd2572f6557f715bce58bc77edbc318c002b2c /build-aux/compile-all.scm
parent6e644cfdb38b74a83bfc133807b5f503b54e8c73 (diff)
downloadguix-2890ad332fcdfd4bc92b127d783975437c8b718b.tar
guix-2890ad332fcdfd4bc92b127d783975437c8b718b.tar.gz
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. <top level>: 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.
Diffstat (limited to 'build-aux/compile-all.scm')
-rw-r--r--build-aux/compile-all.scm92
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)))))))