Re: [PATCH] build: Speed up .go compilation.

[Taylan Ulrich Bayırlı/Kammer]

address@hidden (Ludovic Courtès) writes:

> address@hidden (Taylan Ulrich "Bayırlı/Kammer") skribis:
>
>> I'm having headaches with distcheck.  Currently it bails out because I'm
>> missing tex.  Debian's version is apparently too old, and Guix's version
>> is huge and has been downloading for many hours now.  I'll report back
>> again when I'm done with that.

Distcheck passes.

I also made sure make passes at the absence of gnutls in the
environment.  This obsoletes the hack in the Makefile that was mentioned
on IRC yesterday; here's an updated patch.

>From 61eab1edf73f5af9689fb1e776474fa1921a57fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <address@hidden>
Date: Thu, 5 Nov 2015 23:42:45 +0100
Subject: [PATCH] build: Speed up .go compilation.

* build-aux/compile-all.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.
(%.go, make-go): New rules.
---
 Makefile.am               | 28 ++++++----------
 build-aux/compile-all.scm | 82 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 91 insertions(+), 19 deletions(-)
 create mode 100644 build-aux/compile-all.scm

diff --git a/Makefile.am b/Makefile.am
index 760caed..0b9f2b4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -152,11 +152,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           \
@@ -302,6 +297,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                             \
@@ -341,14 +337,6 @@ 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
@@ -358,14 +346,16 @@ GUILD_COMPILE_FLAGS =                             \
 #
 # 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
+       @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
 
@@ -457,6 +447,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
diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
new file mode 100644
index 0000000..924ec39
--- /dev/null
+++ b/build-aux/compile-all.scm
@@ -0,0 +1,82 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <address@hidden>
+;;;
+;;; 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)))))
-- 
2.6.3