From b8300494c0cef32d7398aee705c9271346d0290e Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Fri, 8 Jan 2016 02:48:17 +0300
Subject: Move <boot-parameters> to (gnu system).

* guix/scripts/system.scm (previous-grub-entries)
  (display-system-generation): Use accessors instead of matching
  <boot-parameters>.
  (boot-parameters, boot-parameters?, boot-parameters-label)
  (boot-parameters-root-device, boot-parameters-kernel)
  (boot-parameters-kernel-arguments, read-boot-parameters): Move to...
* gnu/system.scm: ... here. Export them.
---
 gnu/system.scm | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

(limited to 'gnu/system.scm')

diff --git a/gnu/system.scm b/gnu/system.scm
index 4aedb7ee36..ee0280c069 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -88,6 +88,14 @@
             operating-system-locale-directory
             operating-system-boot-script
 
+            boot-parameters
+            boot-parameters?
+            boot-parameters-label
+            boot-parameters-root-device
+            boot-parameters-kernel
+            boot-parameters-kernel-arguments
+            read-boot-parameters
+
             local-host-aliases
             %setuid-programs
             %base-packages
@@ -709,4 +717,37 @@ this file is the reconstruction of GRUB menu entries for old configurations."
                                     #$(operating-system-kernel-arguments os))
                                    (initrd #$initrd)))))
 
+
+;;;
+;;; Boot parameters
+;;;
+
+(define-record-type* <boot-parameters>
+  boot-parameters make-boot-parameters boot-parameters?
+  (label            boot-parameters-label)
+  (root-device      boot-parameters-root-device)
+  (kernel           boot-parameters-kernel)
+  (kernel-arguments boot-parameters-kernel-arguments))
+
+(define (read-boot-parameters port)
+  "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object or #f if the format is unrecognized."
+  (match (read port)
+    (('boot-parameters ('version 0)
+                       ('label label) ('root-device root)
+                       ('kernel linux)
+                       rest ...)
+     (boot-parameters
+      (label label)
+      (root-device root)
+      (kernel linux)
+      (kernel-arguments
+       (match (assq 'kernel-arguments rest)
+         ((_ args) args)
+         (#f       '())))))                       ;the old format
+    (x                                            ;unsupported format
+     (warning (_ "unrecognized boot parameters for '~a'~%")
+              system)
+     #f)))
+
 ;;; system.scm ends here
-- 
cgit v1.2.3