gnu: Add TomsFastMath.

[jackhill/guix/guix.git] / gnu / system.scm

diff --git a/gnu/system.scm b/gnu/system.scm
index e6118d3..99bc098 100644 (file)
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -359,6 +359,9 @@ marked as 'needed-for-boot'."
     (remove file-system-needed-for-boot?
             (operating-system-file-systems os)))
 
+  (define mapped-devices-for-boot
+    (operating-system-boot-mapped-devices os))
+
   (define (device-mappings fs)
     (let ((device (file-system-device fs)))
       (if (string? device)                        ;title is 'device
@@ -374,21 +377,23 @@ marked as 'needed-for-boot'."
     (file-system
       (inherit fs)
       (dependencies
-       (delete-duplicates (append (device-mappings fs)
-                                  (file-system-dependencies fs))
-                          eq?))))
+       (delete-duplicates
+        (remove (cut member <> mapped-devices-for-boot)
+                (append (device-mappings fs)
+                        (file-system-dependencies fs)))
+        eq?))))
 
   (service file-system-service-type
            (map add-dependencies file-systems)))
 
-(define (mapped-device-user device file-systems)
-  "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
+(define (mapped-device-users device file-systems)
+  "Return the subset of FILE-SYSTEMS that use DEVICE."
   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
-    (find (lambda (fs)
-            (or (member device (file-system-dependencies fs))
-                (and (string? (file-system-device fs))
-                     (string=? (file-system-device fs) target))))
-          file-systems)))
+    (filter (lambda (fs)
+              (or (member device (file-system-dependencies fs))
+                  (and (string? (file-system-device fs))
+                       (string=? (file-system-device fs) target))))
+            file-systems)))
 
 (define (operating-system-user-mapped-devices os)
   "Return the subset of mapped devices that can be installed in
@@ -396,9 +401,8 @@ user-land--i.e., those not needed during boot."
   (let ((devices      (operating-system-mapped-devices os))
         (file-systems (operating-system-file-systems os)))
    (filter (lambda (md)
-             (let ((user (mapped-device-user md file-systems)))
-               (or (not user)
-                   (not (file-system-needed-for-boot? user)))))
+             (let ((users (mapped-device-users md file-systems)))
+               (not (any file-system-needed-for-boot? users))))
            devices)))
 
 (define (operating-system-boot-mapped-devices os)
@@ -407,8 +411,8 @@ from the initrd."
   (let ((devices      (operating-system-mapped-devices os))
         (file-systems (operating-system-file-systems os)))
    (filter (lambda (md)
-             (let ((user (mapped-device-user md file-systems)))
-               (and user (file-system-needed-for-boot? user))))
+             (let ((users (mapped-device-users md file-systems)))
+               (any file-system-needed-for-boot? users)))
            devices)))
 
 (define (device-mapping-services os)
@@ -470,13 +474,13 @@ a container or that of a \"bare metal\" system."
     (cons* (service system-service-type entries)
            %boot-service
 
-           ;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
+           ;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that
            ;; execs shepherd comes last in the boot script (XXX).  Likewise,
-           ;; the cleanup service must come last so that its gexp runs before
+           ;; the cleanup service must come first so that its gexp runs before
            ;; activation code.
-           %shepherd-root-service
-           %activation-service
            (service cleanup-service-type #f)
+           %activation-service
+           %shepherd-root-service
 
            (pam-root-service (operating-system-pam-services os))
            (account-service (append (operating-system-accounts os)
@@ -497,7 +501,7 @@ a container or that of a \"bare metal\" system."
                    ;; Add the firmware service, unless we are building for a
                    ;; container.
                    (if container?
-                       '()
+                       (list %containerized-shepherd-service)
                        (list %linux-bare-metal-service
                              (service firmware-service-type
                                       (operating-system-firmware os))))))))
@@ -602,7 +606,7 @@ directory."
 # because they would require combining both profiles.
 # FIXME: See <http://bugs.gnu.org/20255>.
 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
-export INFOPATH=$HOME/.config/guix/current/share/info:$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
+export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
 
@@ -616,9 +620,6 @@ unset PATH
 GUIX_PROFILE=/run/current-system/profile ; \\
 . /run/current-system/profile/etc/profile
 
-# Prepend setuid programs.
-export PATH=/run/setuid-programs:$PATH
-
 # Since 'lshd' does not use pam_env, /etc/environment must be explicitly
 # loaded when someone logs in via SSH.  See <http://bugs.gnu.org/22175>.
 # We need 'PATH' to be defined here, for 'cat' and 'cut'.  Do this before
@@ -630,7 +631,8 @@ then
   export `cat /etc/environment | cut -d= -f1`
 fi
 
-for profile in \"$HOME/.config/guix/current\" \"$HOME/.guix-profile\"
+# Arrange so that ~/.config/guix/current comes first.
+for profile in \"$HOME/.guix-profile\" \"$HOME/.config/guix/current\"
 do
   if [ -f \"$profile/etc/profile\" ]
   then
@@ -644,6 +646,12 @@ do
   fi
 done
 
+# Prepend setuid programs.
+export PATH=/run/setuid-programs:$PATH
+
+# Arrange so that ~/.config/guix/current/share/info comes first.
+export INFOPATH=\"$HOME/.config/guix/current/share/info:$INFOPATH\"
+
 # Set the umask, notably for users logging in via 'lsh'.
 # See <http://bugs.gnu.org/22650>.
 umask 022
@@ -815,7 +823,6 @@ we're running in the final root.  When CONTAINER? is true, skip all
 hardware-related operations as necessary when booting a Linux container."
   (let* ((services (operating-system-services os #:container? container?))
          (boot     (fold-services services #:target-type boot-service-type)))
-    ;; BOOT is the script as a monadic value.
     (service-value boot)))
 
 (define (operating-system-user-accounts os)