~ruther/guix-local

de6af32783991d74a55d68bfd809cc56020e155b — Taylan Ulrich Bayırlı/Kammer 10 years ago 8047d13
build: Speed up .go compilation.

* build-aux/compile-all.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.
(%.go, make-go): New rules.
2 files changed, 91 insertions(+), 23 deletions(-)

M Makefile.am
A build-aux/compile-all.scm
M Makefile.am => Makefile.am +9 -23
@@ 164,11 164,6 @@ endif BUILD_DAEMON_OFFLOAD
# Internal module with test suite support.
dist_noinst_DATA = guix/tests.scm

# Because of the autoload hack in (guix build download), we must build it
# first to avoid errors on systems where (gnutls) is unavailable.
guix/scripts/download.go: guix/build/download.go
guix/download.go: guix/build/download.go

# Linux-Libre configurations.
KCONFIGS =					\
  gnu/packages/linux-libre-i686.conf		\


@@ 325,6 320,7 @@ EXTRA_DIST =						\
  CODE-OF-CONDUCT					\
  .dir-locals.el					\
  build-aux/build-self.scm				\
  build-aux/compile-all.scm				\
  build-aux/hydra/gnu-system.scm			\
  build-aux/hydra/demo-os.scm				\
  build-aux/hydra/guix.scm				\


@@ 364,31 360,21 @@ CLEANFILES =					\
  $(GOBJECTS)					\
  $(SCM_TESTS:tests/%.scm=%.log)

AM_V_GUILEC = $(AM_V_GUILEC_$(V))
AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY))
AM_V_GUILEC_0 = @echo "  GUILEC" $@;

# Flags passed to 'guild compile'.
GUILD_COMPILE_FLAGS =				\
  -Wformat -Wunbound-variable -Warity-mismatch

# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling.  Otherwise, if
# $GUILE_LOAD_COMPILED_PATH contains $(moduledir), we may find .go files in
# there that are newer than the local .scm files (for instance because the
# user ran 'make install' recently).  When that happens, we end up loading
# those previously-installed .go files, which may be stale, thereby breaking
# the whole thing.
#
# XXX: Use the C locale for when Guile lacks
# <http://git.sv.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=e2c6bf3866d1186c60bacfbd4fe5037087ee5e3f>.
.scm.go:
	$(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ;			\
%.go: make-go ; @:
make-go: $(MODULES) guix/config.scm guix/tests.scm
	$(AM_V_at)echo "Compiling Scheme modules..." ;			\
	unset GUILE_LOAD_COMPILED_PATH ;				\
	LC_ALL=C							\
	host=$(host) srcdir="$(top_srcdir)"				\
	$(top_builddir)/pre-inst-env					\
	$(GUILD) compile -L "$(top_builddir)" -L "$(top_srcdir)"	\
	  $(GUILD_COMPILE_FLAGS) --target="$(host)"			\
	  -o "$@" "$<"
	$(GUILE) -L "$(top_builddir)" -L "$(top_srcdir)"		\
	  --no-auto-compile 						\
	  -s "$(top_srcdir)"/build-aux/compile-all.scm $^

SUFFIXES = .go



@@ 480,6 466,6 @@ assert-final-inputs-self-contained:
	$(top_builddir)/pre-inst-env "$(GUILE)"				\
	  "$(top_srcdir)/build-aux/check-final-inputs-self-contained.scm"

.PHONY: sync-descriptions gen-ChangeLog gen-AUTHORS clean-go
.PHONY: sync-descriptions gen-ChangeLog gen-AUTHORS clean-go make-go
.PHONY: assert-no-store-file-names assert-binaries-available
.PHONY: assert-final-inputs-self-contained

A build-aux/compile-all.scm => build-aux/compile-all.scm +82 -0
@@ 0,0 1,82 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 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/>.

(use-modules (system base target)
             (ice-9 match)
             (ice-9 threads)
             (guix build utils))

(define compile-options '(format unbound-variable arity-mismatch))

(define host (getenv "host"))

(define srcdir (getenv "srcdir"))

(define (relative-file file)
  (if (string-prefix? (string-append srcdir "/") file)
      (string-drop file (+ 1 (string-length srcdir)))
      file))

(define (file-mtime<? f1 f2)
  (< (stat:mtime (stat f1))
     (stat:mtime (stat f2))))

(define (scm->go file)
  (let* ((relative (relative-file file))
         (without-extension (string-drop-right relative 4)))
    (string-append without-extension ".go")))

(define (file-needs-compilation? file)
  (let ((go (scm->go file)))
    (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)))

(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-target host
      (lambda ()
        (compile-file file
                      #:output-file go
                      #:opts compile-options)))))

(match (command-line)
  ((_ . files)
   (let ((files (filter file-needs-compilation? files)))
     (for-each load-module-file files)
     (let ((mutex (make-mutex)))
       (par-for-each (lambda (file)
                       (compile-file* file mutex))
                     files)))))