+(define-syntax vhash ;TODO: factorize
+ (syntax-rules (=>)
+ "Build a vhash with the given key/value mappings."
+ ((_)
+ vlist-null)
+ ((_ (key others ... => value) rest ...)
+ (vhash-cons key value
+ (vhash (others ... => value) rest ...)))
+ ((_ (=> value) rest ...)
+ (vhash rest ...))))
+
+(define-syntax lookup-procedure
+ (syntax-rules (else)
+ "Return a procedure that lookups keys in the given dictionary."
+ ((_ mapping ... (else default))
+ (let ((table (vhash mapping ...)))
+ (lambda (key)
+ (match (vhash-assoc key table)
+ (#f default)
+ ((key . value) value)))))))
+
+(define file-system-type-modules
+ ;; Given a file system type, return the list of modules it needs.
+ (lookup-procedure ("cifs" => '("md4" "ecb" "cifs"))
+ ("9p" => '("9p" "9pnet_virtio"))
+ ("bcachefs" => '("bcachefs"))
+ ("btrfs" => '("btrfs"))
+ ("iso9660" => '("isofs"))
+ ("jfs" => '("jfs"))
+ ("f2fs" => '("f2fs" "crc32_generic"))
+ (else '())))
+
+(define (file-system-modules file-systems)
+ "Return the list of Linux modules needed to mount FILE-SYSTEMS."
+ (append-map (compose file-system-type-modules file-system-type)
+ file-systems))
+
+(define* (default-initrd-modules
+ #:optional
+ (system (or (%current-target-system)
+ (%current-system))))
+ "Return the list of modules included in the initrd by default."
+ (define virtio-modules
+ ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
+ '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
+ "virtio_console" "virtio-rng"))
+
+ `("ahci" ;for SATA controllers
+ "usb-storage" "uas" ;for the installation image etc.
+ "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
+ "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
+ "nls_iso8859-1" ;for `mkfs.fat`, et.al
+ ,@(if (string-match "^(x86_64|i[3-6]86)-" system)
+ '("pata_acpi" "pata_atiixp" ;for ATA controllers
+ "isci") ;for SAS controllers like Intel C602
+ '())
+
+ ,@virtio-modules))
+
+(define-syntax %base-initrd-modules
+ ;; This more closely matches our naming convention.
+ (identifier-syntax (default-initrd-modules)))
+