gnu: Use 'gexp->file' in conjunction with 'with-imported-modules'.

* gnu/services.scm (activation-script): Remove code to set '%load-path'
and use 'with-imported-modules' instead.
(cleanup-gexp): Likewise.
* gnu/system/vm.scm (%vm-module-closure): New variable.
(expression->derivation-in-linux-vm): Remove #:modules.
[loader]: Remove code to set '%load-path'.
[builder]: Use %VM-MODULE-CLOSURE.
(qemu-image): Use 'with-imported-modules'.

2 files changed, 97 insertions, 119 deletions

diff --git a/gnu/services.scm b/gnu/services.scm
index 661835f68e..5479bfae19 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -238,42 +238,33 @@ directory."
 (define (cleanup-gexp _)
   "Return as a monadic value a gexp to clean up /tmp and similar places upon
 boot."
-  (define %modules
-    '((guix build utils)))
-
-  (mlet %store-monad ((modules  (imported-modules %modules))
-                      (compiled (compiled-modules %modules)))
-    (return #~(begin
-                (eval-when (expand load eval)
-                  ;; Make sure 'use-modules' below succeeds.
-                  (set! %load-path (cons #$modules %load-path))
-                  (set! %load-compiled-path
-                    (cons #$compiled %load-compiled-path)))
-
-                (use-modules (guix build utils))
-
-                ;; Clean out /tmp and /var/run.
-                ;;
-                ;; XXX This needs to happen before service activations, so it
-                ;; has to be here, but this also implicitly assumes that /tmp
-                ;; and /var/run are on the root partition.
-                (letrec-syntax ((fail-safe (syntax-rules ()
-                                             ((_ exp rest ...)
-                                              (begin
-                                                (catch 'system-error
-                                                  (lambda () exp)
-                                                  (const #f))
-                                                (fail-safe rest ...)))
-                                             ((_)
-                                              #t))))
-                  ;; Ignore I/O errors so the system can boot.
-                  (fail-safe
-                   (delete-file-recursively "/tmp")
-                   (delete-file-recursively "/var/run")
-                   (mkdir "/tmp")
-                   (chmod "/tmp" #o1777)
-                   (mkdir "/var/run")
-                   (chmod "/var/run" #o755)))))))
+  (with-monad %store-monad
+    (with-imported-modules '((guix build utils))
+      (return #~(begin
+                  (use-modules (guix build utils))
+
+                  ;; Clean out /tmp and /var/run.
+                  ;;
+                  ;; XXX This needs to happen before service activations, so it
+                  ;; has to be here, but this also implicitly assumes that /tmp
+                  ;; and /var/run are on the root partition.
+                  (letrec-syntax ((fail-safe (syntax-rules ()
+                                               ((_ exp rest ...)
+                                                (begin
+                                                  (catch 'system-error
+                                                    (lambda () exp)
+                                                    (const #f))
+                                                  (fail-safe rest ...)))
+                                               ((_)
+                                                #t))))
+                    ;; Ignore I/O errors so the system can boot.
+                    (fail-safe
+                     (delete-file-recursively "/tmp")
+                     (delete-file-recursively "/var/run")
+                     (mkdir "/tmp")
+                     (chmod "/tmp" #o1777)
+                     (mkdir "/var/run")
+                     (chmod "/var/run" #o755))))))))
 
 (define cleanup-service-type
   ;; Service that cleans things up in /tmp and similar.
@@ -337,29 +328,22 @@ ACTIVATION-SCRIPT-TYPE."
           (cut gexp->file "activate-service" <>)
           gexps))
 
-  (mlet* %store-monad ((actions  (service-activations))
-                       (modules  (imported-modules %modules))
-                       (compiled (compiled-modules %modules)))
+  (mlet* %store-monad ((actions (service-activations)))
     (gexp->file "activate"
-                #~(begin
-                    (eval-when (expand load eval)
-                      ;; Make sure 'use-modules' below succeeds.
-                      (set! %load-path (cons #$modules %load-path))
-                      (set! %load-compiled-path
-                        (cons #$compiled %load-compiled-path)))
-
-                    (use-modules (gnu build activation))
+                (with-imported-modules %modules
+                  #~(begin
+                      (use-modules (gnu build activation))
 
-                    ;; Make sure /bin/sh is valid and current.
-                    (activate-/bin/sh
-                     (string-append #$(canonical-package bash) "/bin/sh"))
+                      ;; Make sure /bin/sh is valid and current.
+                      (activate-/bin/sh
+                       (string-append #$(canonical-package bash) "/bin/sh"))
 
-                    ;; Run the services' activation snippets.
-                    ;; TODO: Use 'load-compiled'.
-                    (for-each primitive-load '#$actions)
+                      ;; Run the services' activation snippets.
+                      ;; TODO: Use 'load-compiled'.
+                      (for-each primitive-load '#$actions)
 
-                    ;; Set up /run/current-system.
-                    (activate-current-system)))))
+                      ;; Set up /run/current-system.
+                      (activate-current-system))))))
 
 (define (gexps->activation-gexp gexps)
   "Return a gexp that runs the activation script containing GEXPS."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index fc5eaf5706..c31e3a80ef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -90,6 +90,21 @@
           (options "trans=virtio")
           (check? #f))))
 
+(define %vm-module-closure
+  ;; The closure of (gnu build vm), roughly.
+  ;; FIXME: Compute it automatically.
+  '((gnu build vm)
+    (gnu build install)
+    (gnu build linux-boot)
+    (gnu build linux-modules)
+    (gnu build file-systems)
+    (guix elf)
+    (guix records)
+    (guix build utils)
+    (guix build syscalls)
+    (guix build bournish)
+    (guix build store-copy)))
+
 (define* (expression->derivation-in-linux-vm name exp
                                              #:key
                                              (system (%current-system))
@@ -97,18 +112,6 @@
                                              initrd
                                              (qemu qemu-minimal)
                                              (env-vars '())
-                                             (modules
-                                              '((gnu build vm)
-                                                (gnu build install)
-                                                (gnu build linux-boot)
-                                                (gnu build linux-modules)
-                                                (gnu build file-systems)
-                                                (guix elf)
-                                                (guix records)
-                                                (guix build utils)
-                                                (guix build syscalls)
-                                                (guix build bournish)
-                                                (guix build store-copy)))
                                              (guile-for-build
                                               (%guile-for-build))
 
@@ -128,23 +131,13 @@ When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
 DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
 return it.
 
-MODULES is the set of modules imported in the execution environment of EXP.
-
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs, as for `derivation'.  The files containing the reference graphs are
 made available under the /xchg CIFS share."
   (mlet* %store-monad
-      ((module-dir   (imported-modules modules))
-       (compiled     (compiled-modules modules))
-       (user-builder (gexp->file "builder-in-linux-vm" exp))
+      ((user-builder (gexp->file "builder-in-linux-vm" exp))
        (loader       (gexp->file "linux-vm-loader"
-                                 #~(begin
-                                     (set! %load-path
-                                           (cons #$module-dir %load-path))
-                                     (set! %load-compiled-path
-                                           (cons #$compiled
-                                                 %load-compiled-path))
-                                     (primitive-load #$user-builder))))
+                                 #~(primitive-load #$user-builder)))
        (coreutils -> (canonical-package coreutils))
        (initrd       (if initrd                   ; use the default initrd?
                          (return initrd)
@@ -155,7 +148,7 @@ made available under the /xchg CIFS share."
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      (with-imported-modules modules
+      (with-imported-modules %vm-module-closure
         #~(begin
             (use-modules (guix build utils)
                          (gnu build vm))
@@ -212,45 +205,46 @@ register INPUTS in the store database of the image so that Guix can be used in
 the image."
   (expression->derivation-in-linux-vm
    name
-   #~(begin
-       (use-modules (gnu build vm)
-                    (guix build utils))
-
-       (let ((inputs
-              '#$(append (list qemu parted grub e2fsprogs)
-                         (map canonical-package
-                              (list sed grep coreutils findutils gawk))
-                         (if register-closures? (list guix) '())))
-
-             ;; This variable is unused but allows us to add INPUTS-TO-COPY
-             ;; as inputs.
-             (to-register
-              '#$(map (match-lambda
-                       ((name thing) thing)
-                       ((name thing output) `(,thing ,output)))
-                      inputs)))
-
-         (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-         (let* ((graphs     '#$(match inputs
-                                 (((names . _) ...)
-                                  names)))
-                (initialize (root-partition-initializer
-                             #:closures graphs
-                             #:copy-closures? #$copy-inputs?
-                             #:register-closures? #$register-closures?
-                             #:system-directory #$os-derivation))
-                (partitions (list (partition
-                                   (size #$(- disk-image-size
-                                              (* 10 (expt 2 20))))
-                                   (label #$file-system-label)
-                                   (file-system #$file-system-type)
-                                   (bootable? #t)
-                                   (initializer initialize)))))
-           (initialize-hard-disk "/dev/vda"
-                                 #:partitions partitions
-                                 #:grub.cfg #$grub-configuration)
-           (reboot))))
+   (with-imported-modules %vm-module-closure
+     #~(begin
+         (use-modules (gnu build vm)
+                      (guix build utils))
+
+         (let ((inputs
+                '#$(append (list qemu parted grub e2fsprogs)
+                           (map canonical-package
+                                (list sed grep coreutils findutils gawk))
+                           (if register-closures? (list guix) '())))
+
+               ;; This variable is unused but allows us to add INPUTS-TO-COPY
+               ;; as inputs.
+               (to-register
+                '#$(map (match-lambda
+                          ((name thing) thing)
+                          ((name thing output) `(,thing ,output)))
+                        inputs)))
+
+           (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+           (let* ((graphs     '#$(match inputs
+                                   (((names . _) ...)
+                                    names)))
+                  (initialize (root-partition-initializer
+                               #:closures graphs
+                               #:copy-closures? #$copy-inputs?
+                               #:register-closures? #$register-closures?
+                               #:system-directory #$os-derivation))
+                  (partitions (list (partition
+                                     (size #$(- disk-image-size
+                                                (* 10 (expt 2 20))))
+                                     (label #$file-system-label)
+                                     (file-system #$file-system-type)
+                                     (bootable? #t)
+                                     (initializer initialize)))))
+             (initialize-hard-disk "/dev/vda"
+                                   #:partitions partitions
+                                   #:grub.cfg #$grub-configuration)
+             (reboot)))))
    #:system system
    #:make-disk-image? #t
    #:disk-image-size disk-image-size