From 2455085a1e845297584683405878a49f44c17567 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 27 Aug 2013 19:04:14 +0200
Subject: vm: Use more keyword parameters for
 `expression->derivation-in-linux-vm'.

* gnu/system/vm.scm (expression->derivation-in-linux-vm): Turn `system'
  and `inputs' into keyword parameters.
  (qemu-image, example1): Adjust accordingly.
---
 gnu/system/vm.scm | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

(limited to 'gnu')

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index bc5677963d..fedf0ee322 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -40,8 +40,10 @@
 ;;;
 ;;; Code:
 
-(define* (expression->derivation-in-linux-vm store name system exp inputs
+(define* (expression->derivation-in-linux-vm store name exp
                                              #:key
+                                             (system (%current-system))
+                                             (inputs '())
                                              (linux linux-libre)
                                              (initrd qemu-initrd)
                                              (qemu qemu/smb-shares)
@@ -150,7 +152,7 @@ DISK-IMAGE-SIZE bytes and return it."
                      (inputs '()))
   "Return a bootable, stand-alone QEMU image."
   (expression->derivation-in-linux-vm
-   store "qemu-image" system
+   store "qemu-image"
    `(let ((parted  (string-append (assoc-ref %build-inputs "parted")
                                   "/sbin/parted"))
           (mkfs    (string-append (assoc-ref %build-inputs "e2fsprogs")
@@ -212,19 +214,20 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
                          (zero?
                           (system* umount "/fs"))
                          (reboot)))))))
-   `(("parted" ,parted)
-     ("grub" ,grub)
-     ("e2fsprogs" ,e2fsprogs)
-     ("linux" ,linux-libre)
-     ("initrd" ,qemu-initrd)
+   #:system system
+   #:inputs `(("parted" ,parted)
+              ("grub" ,grub)
+              ("e2fsprogs" ,e2fsprogs)
+              ("linux" ,linux-libre)
+              ("initrd" ,qemu-initrd)
 
-     ;; For shell scripts.
-     ("sed" ,(car (assoc-ref %final-inputs "sed")))
-     ("grep" ,(car (assoc-ref %final-inputs "grep")))
-     ("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
-     ("findutils" ,(car (assoc-ref %final-inputs "findutils")))
-     ("gawk" ,(car (assoc-ref %final-inputs "gawk")))
-     ("util-linux" ,util-linux))
+              ;; For shell scripts.
+              ("sed" ,(car (assoc-ref %final-inputs "sed")))
+              ("grep" ,(car (assoc-ref %final-inputs "grep")))
+              ("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
+              ("findutils" ,(car (assoc-ref %final-inputs "findutils")))
+              ("gawk" ,(car (assoc-ref %final-inputs "gawk")))
+              ("util-linux" ,util-linux))
    #:make-disk-image? #t
    #:disk-image-size disk-image-size))
 
@@ -241,13 +244,12 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
       (lambda ()
         (parameterize ((%guile-for-build (package-derivation store guile-final)))
           (expression->derivation-in-linux-vm
-           store "vm-test" (%current-system)
+           store "vm-test"
            '(begin
               (display "hello from boot!\n")
               (call-with-output-file "/xchg/hello"
                 (lambda (p)
-                  (display "world" p))))
-           '())))
+                  (display "world" p)))))))
       (lambda ()
         (close-connection store)))))
 
-- 
cgit v1.2.3