GNU bug report logs - #34982
[PATCH] guile-build-system: Support building in parallel.

Previous Next

Full log

View this message in rfc822 format

From: Christopher Baines <mail <at> cbaines.net>
To: 34982 <at> debbugs.gnu.org
Subject: [bug#34982] [PATCH] guile-build-system: Support building in parallel.
Date: Sun, 24 Mar 2019 21:23:45 +0000

* guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
for-each, to use multiple cores if available.
---
 guix/build/guile-build-system.scm | 43 +++++++++++++++++++------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index 0bed049436..a5741081bf 100644
--- a/guix/build/guile-build-system.scm
+++ b/guix/build/guile-build-system.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 threads)
   #:use-module (guix build utils)
   #:export (target-guile-effective-version
             %standard-phases
@@ -101,24 +102,32 @@ Return #false if it cannot be determined."
                            (match (getenv "GUILE_LOAD_COMPILED_PATH")
                              (#f "")
                              (path (string-append ":" path)))))
-    (for-each (lambda (file)
-                (let* ((go (string-append go-dir
-                                          (file-sans-extension file)
-                                          ".go")))
-                  ;; Install source module.
-                  (install-file (string-append source-directory "/" file)
-                                (string-append module-dir
-                                               "/" (dirname file)))
+    (n-par-for-each
+     (parallel-job-count)
+     (lambda (file)
+       (catch #t
+         (lambda ()
+           (let* ((go (string-append go-dir
+                                     (file-sans-extension file)
+                                     ".go")))
+             ;; Install source module.
+             (install-file (string-append source-directory "/" file)
+                           (string-append module-dir
+                                          "/" (dirname file)))
 
-                  ;; Install and compile module.
-                  (apply invoke guild "compile" "-L" source-directory
-                         "-o" go
-                         (string-append source-directory "/" file)
-                         flags)))
-
-              ;; Arrange to strip SOURCE-DIRECTORY from file names.
-              (with-directory-excursion source-directory
-                (find-files "." scheme-file-regexp)))
+             ;; Install and compile module.
+             (apply invoke guild "compile" "-L" source-directory
+                    "-o" go
+                    (string-append source-directory "/" file)
+                    flags)))
+         (lambda (key . args)
+           ;; Since ports are not thread-safe as of Guile 2.0, reopen stderr.
+           (let ((port (fdopen 2 "w0")))
+             (print-exception port #f key args)
+             (primitive-exit 1)))))
+     ;; Arrange to strip SOURCE-DIRECTORY from file names.
+     (with-directory-excursion source-directory
+       (find-files "." scheme-file-regexp)))
     #t))
 
 (define* (install-documentation #:key outputs
-- 
2.20.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.