graft: Perform grafts with guile-final.

* guix/build/graft.scm (rewrite-directory): Rewrite store directories in
individual files sequentially.
(exit-on-exception): Remove procedure.
* guix/packages.scm (guile-for-grafts): Switch to guile-final.

Change-Id: I50f7b23a3ceff8bb1495dc1f4bc772746147d924

guix/build/graft.scm

@@ -299,19 +299,6 @@ a list of store file name pairs."
                                (string-append (dirname file) "/" target))))
               matches)))
 
-(define (exit-on-exception proc)
-  "Return a procedure that wraps PROC so that 'primitive-exit' is called when
-an exception is caught."
-  (lambda (arg)
-    (catch #t
-      (lambda ()
-        (proc arg))
-      (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))))))
-
 (define* (rewrite-directory directory output mapping
                             #:optional (store (%store-directory)))
   "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of
@@ -383,13 +370,10 @@ file name pairs."
         (else
          (error "unsupported file type" stat)))))
 
-  ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that
+  ;; n-par-for-each can lead to segfaults in the grafting code?
-  ;; 'n-par-for-each' silently swallows exceptions.
+  (for-each rewrite-leaf
-  ;; See <http://bugs.gnu.org/23581>.
+            (find-files directory (const #t)
-  (n-par-for-each (parallel-job-count)
+                        #:directories? #t))
-                  (exit-on-exception rewrite-leaf)
-                  (find-files directory (const #t)
-                              #:directories? #t))
   (rename-matching-files output mapping))
 
 (define %graft-hooks

guix/packages.scm

@@ -932,10 +932,8 @@ derivations."
 
 (define (guile-for-grafts)
   "Return the Guile package used to build grafting derivations."
-  ;; Guile 2.2 would not work due to <https://bugs.gnu.org/28211> when
+  (let ((distro (resolve-interface '(gnu packages commencement))))
-  ;; grafting packages.
+    (module-ref distro 'guile-final)))
-  (let ((distro (resolve-interface '(gnu packages guile))))
-    (module-ref distro 'guile-2.0)))
 
 (define* (default-guile-derivation #:optional (system (%current-system)))
   "Return the derivation for SYSTEM of the default Guile package used to run