pull: Limit memory usage when compiling.

Reported by Arne Babenhauserheide <arne.babenhauserheide@kit.edu>.

* guix/scripts/pull.scm (unpack)[builder](compile-file*): Change to run
  'compile-file' in a child process.  This limits memory usage; before
  that memory usage was proportional to the number of files to compile.

1 files changed, 21 insertions, 31 deletions

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 5ff2ce0cc1..23f20493d1 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -60,38 +60,28 @@ files."
              (tarball (assoc-ref %build-inputs "tarball")))
 
          (define* (compile-file* file #:key output-file (opts '()))
-           ;; Like 'compile-file', but remove any (guix …) and (gnu …) modules
-           ;; created during the process as an ugly workaround for
+           ;; Like 'compile-file', but in a separate process, to work around
            ;; <http://bugs.gnu.org/15602> (FIXME).  This ensures correctness,
-           ;; but is overly conservative and very slow.
-
-           (define (module-directory+file module)
-             ;; Return the directory for MODULE, like the 'dir-hint' in
-             ;; boot-9.scm.
-             (match (module-name module)
-               ((beginning ... last)
-                (values (string-concatenate
-                         (map (lambda (elt)
-                                (string-append (symbol->string elt)
-                                               file-name-separator-string))
-                              beginning))
-                        (symbol->string last)))))
-
-           (define (clear-module-tree! root)
-             ;; Delete all the modules under ROOT.
-             (hash-for-each (lambda (name module)
-                              (module-remove! root name)
-                              (let-values (((dir name)
-                                            (module-directory+file module)))
-                                (set-autoloaded! dir name #f))
-                              (clear-module-tree! module))
-                            (module-submodules root))
-             (hash-clear! (module-submodules root)))
-
-           (compile-file file #:output-file output-file #:opts opts)
-
-           (for-each (compose clear-module-tree! resolve-module)
-                     '((guix) (gnu))))
+           ;; but is overly conservative and very slow.  The solution
+           ;; initially implemented (and described in the bug above) was
+           ;; slightly faster but consumed memory proportional to the number
+           ;; of modules, which quickly became unacceptable.
+           (match (primitive-fork)
+             (0
+              (catch #t
+                (lambda ()
+                  (compile-file file
+                                #:output-file output-file
+                                #:opts opts)
+                  (primitive-exit 0))
+                (lambda (key . args)
+                  (print-exception (current-error-port) #f key args)
+                  (primitive-exit 1))))
+             (pid
+              (match (waitpid pid)
+                ((_ . status)
+                 (unless (zero? (status:exit-val status))
+                   (error "failed to compile file" file status)))))))
 
          (setenv "PATH" (string-append tar "/bin:" gzip "/bin"))