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

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

[Christopher Baines]

* 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

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

[Ludovic Courtès]

Hi,

Christopher Baines <mail@cbaines.net> skribis:

> * guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
> for-each, to use multiple cores if available.

[...]

> +    (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

It probably doesn’t matter that much, but it feels wrong to create
threads that do nothing but call ‘waitpid’, essentially.

Commit f07041f7d25badb7d74b8fad6ee446a12af04f63 removed a ‘p-for-each’
procedure that could be useful here since it directly creates N
processes and then does (waitpid WAITPID_ANY).  Would it make sense to
paste it here and use it in lieu of ‘n-par-for-each’?

Thanks,
Ludo’.

[PATCH] guile-build-system: Support building in parallel.

[Christopher Baines]

* guix/build/guile-build-system.scm (build): Use invoke-each, instead of
for-each, to use multiple cores if available.
(invoke-each, report-build-process): New procedures.
---
 guix/build/guile-build-system.scm | 96 +++++++++++++++++++++++++------
 1 file changed, 78 insertions(+), 18 deletions(-)

diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index 0bed049436..5ad728361a 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
@@ -65,6 +66,59 @@ Return #false if it cannot be determined."
      (setenv "GUIX_LOCPATH" (string-append locales "/lib/locale"))
      #t)))
 
+(define* (invoke-each commands
+                      #:key (max-processes (current-processor-count))
+                      report-progress)
+  "Run each command in COMMANDS in a separate process, using up to
+MAX-PROCESSES processes in parallel.  Call REPORT-PROGRESS at each step.
+Raise an error if one of the processes exit with non-zero."
+  (define total
+    (length commands))
+
+  (define (wait-for-one-process)
+    (match (waitpid WAIT_ANY)
+      ((_ . status)
+       (unless (zero? (status:exit-val status))
+         (error "process failed" status)))))
+
+  (define (fork-and-run-command command)
+    (match (primitive-fork)
+      (0
+       (apply execlp command))
+      (pid
+       #t)))
+
+  (let loop ((commands  commands)
+             (running   0)
+             (completed 0))
+    (match commands
+      (()
+       (or (zero? running)
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed))))
+      ((command . rest)
+       (if (< running max-processes)
+           (let ((running (+ 1 running)))
+             (fork-and-run-command command)
+             (report-progress total completed)
+             (loop rest running completed))
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed)))))))
+
+(define* (report-build-progress total completed
+                                #:optional (log-port (current-error-port)))
+  "Report that COMPLETED out of TOTAL files have been completed."
+  (display #\cr log-port)
+  (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+          (* 100. (/ completed total)) total)
+  (force-output log-port))
+
 (define* (build #:key outputs inputs native-inputs
                 (source-directory ".")
                 (compile-flags '())
@@ -101,24 +155,30 @@ 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)))
-
-                  ;; 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)))
+
+  (let ((source-files
+           (with-directory-excursion source-directory
+             (find-files "." scheme-file-regexp))))
+    (invoke-each
+     (map (lambda (file)
+            (cons* guild
+                   "guild" "compile"
+                   "-L" source-directory
+                   "-o" (string-append go-dir
+                                       (file-sans-extension file)
+                                       ".go")
+                   (string-append source-directory "/" file)
+                   flags))
+          source-files)
+     #:max-processes (parallel-job-count)
+     #:report-progress report-build-progress)
+
+    (for-each
+     (lambda (file)
+         (install-file (string-append source-directory "/" file)
+                       (string-append module-dir
+                                      "/" (dirname file))))
+     source-files))
     #t))
 
 (define* (install-documentation #:key outputs
-- 
2.21.0

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

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1524 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Hi,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> * guix/build/guile-build-system.scm (build): Use n-par-for-each, instead of
>> for-each, to use multiple cores if available.
>
> [...]
>
>> +    (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
>
> It probably doesn’t matter that much, but it feels wrong to create
> threads that do nothing but call ‘waitpid’, essentially.
>
> Commit f07041f7d25badb7d74b8fad6ee446a12af04f63 removed a ‘p-for-each’
> procedure that could be useful here since it directly creates N
> processes and then does (waitpid WAITPID_ANY).  Would it make sense to
> paste it here and use it in lieu of ‘n-par-for-each’?

I've sent a new patch with an updated approach now, I started with the
n-par-for-each procedure, and adapted it. It seems to work, let me know
what you think :)

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

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

[Ludovic Courtès]

Hello Christopher!

Christopher Baines <mail@cbaines.net> skribis:

> I've sent a new patch with an updated approach now, I started with the
> n-par-for-each procedure, and adapted it. It seems to work, let me know
> what you think :)

Sorry for the delay, but… where’s the new patch?

Ludo’.

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

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 507 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Hello Christopher!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> I've sent a new patch with an updated approach now, I started with the
>> n-par-for-each procedure, and adapted it. It seems to work, let me know
>> what you think :)
>
> Sorry for the delay, but… where’s the new patch?

Hmm, I'm not sure. I thought I sent it, but seemingly not.

I've just sent the updated patch, and it's definately arrived now.

Thanks,

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

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

[Christopher Baines]

* guix/build/guile-build-system.scm (build): Use invoke-each, instead of
for-each, to use multiple cores if available.
(invoke-each, report-build-process): New procedures.
---
 guix/build/guile-build-system.scm | 96 +++++++++++++++++++++++++------
 1 file changed, 78 insertions(+), 18 deletions(-)

diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index 0bed049436..5ad728361a 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
@@ -65,6 +66,59 @@ Return #false if it cannot be determined."
      (setenv "GUIX_LOCPATH" (string-append locales "/lib/locale"))
      #t)))
 
+(define* (invoke-each commands
+                      #:key (max-processes (current-processor-count))
+                      report-progress)
+  "Run each command in COMMANDS in a separate process, using up to
+MAX-PROCESSES processes in parallel.  Call REPORT-PROGRESS at each step.
+Raise an error if one of the processes exit with non-zero."
+  (define total
+    (length commands))
+
+  (define (wait-for-one-process)
+    (match (waitpid WAIT_ANY)
+      ((_ . status)
+       (unless (zero? (status:exit-val status))
+         (error "process failed" status)))))
+
+  (define (fork-and-run-command command)
+    (match (primitive-fork)
+      (0
+       (apply execlp command))
+      (pid
+       #t)))
+
+  (let loop ((commands  commands)
+             (running   0)
+             (completed 0))
+    (match commands
+      (()
+       (or (zero? running)
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed))))
+      ((command . rest)
+       (if (< running max-processes)
+           (let ((running (+ 1 running)))
+             (fork-and-run-command command)
+             (report-progress total completed)
+             (loop rest running completed))
+           (let ((running   (- running 1))
+                 (completed (+ completed 1)))
+             (wait-for-one-process)
+             (report-progress total completed)
+             (loop commands running completed)))))))
+
+(define* (report-build-progress total completed
+                                #:optional (log-port (current-error-port)))
+  "Report that COMPLETED out of TOTAL files have been completed."
+  (display #\cr log-port)
+  (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+          (* 100. (/ completed total)) total)
+  (force-output log-port))
+
 (define* (build #:key outputs inputs native-inputs
                 (source-directory ".")
                 (compile-flags '())
@@ -101,24 +155,30 @@ 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)))
-
-                  ;; 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)))
+
+  (let ((source-files
+           (with-directory-excursion source-directory
+             (find-files "." scheme-file-regexp))))
+    (invoke-each
+     (map (lambda (file)
+            (cons* guild
+                   "guild" "compile"
+                   "-L" source-directory
+                   "-o" (string-append go-dir
+                                       (file-sans-extension file)
+                                       ".go")
+                   (string-append source-directory "/" file)
+                   flags))
+          source-files)
+     #:max-processes (parallel-job-count)
+     #:report-progress report-build-progress)
+
+    (for-each
+     (lambda (file)
+         (install-file (string-append source-directory "/" file)
+                       (string-append module-dir
+                                      "/" (dirname file))))
+     source-files))
     #t))
 
 (define* (install-documentation #:key outputs
-- 
2.21.0

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

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> * guix/build/guile-build-system.scm (build): Use invoke-each, instead of
> for-each, to use multiple cores if available.
> (invoke-each, report-build-process): New procedures.

[...]

> +  (define (fork-and-run-command command)
> +    (match (primitive-fork)
> +      (0
> +       (apply execlp command))
> +      (pid
> +       #t)))

To be on the safe side, you should probably wrap the ‘execlp’ call like
this:

  (dynamic-wind
    (const #t)
    (lambda ()
      (apply execlp command))
    (lambda ()
      (primitive-exit 127)))

This ensures that the child process exits immediately if something goes
wrong (e.g., ‘execlp’ raises an exception because the executable could
not be found.)

Otherwise LGTM, thank you!

Ludo’.

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

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1077 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> * guix/build/guile-build-system.scm (build): Use invoke-each, instead of
>> for-each, to use multiple cores if available.
>> (invoke-each, report-build-process): New procedures.
>
> [...]
>
>> +  (define (fork-and-run-command command)
>> +    (match (primitive-fork)
>> +      (0
>> +       (apply execlp command))
>> +      (pid
>> +       #t)))
>
> To be on the safe side, you should probably wrap the ‘execlp’ call like
> this:
>
>   (dynamic-wind
>     (const #t)
>     (lambda ()
>       (apply execlp command))
>     (lambda ()
>       (primitive-exit 127)))
>
> This ensures that the child process exits immediately if something goes
> wrong (e.g., ‘execlp’ raises an exception because the executable could
> not be found.)
>
> Otherwise LGTM, thank you!

Great, I've added in dynamic-wind, made some minor tweaks to the output,
and pushed this as 3fdb9a375f1cee7dd302349a9527437df20b3f61.

Thanks for taking a look :)

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]