From 7ea1432e22b42969ff0d078e68f5cb55a75b1aca Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 18 May 2015 07:49:44 -0400
Subject: ui: Factorize user-provided Scheme file loading.

* guix/ui.scm (make-user-module, load*): New procedures.
* guix/scripts/system.scm (%user-module): Define in terms of
  'make-user-module'.
  (read-operating-system): Define in terms of load*'.
---
 guix/scripts/system.scm | 22 ++++------------------
 guix/ui.scm             | 24 ++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 1838e89452..459b2da0cc 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -48,28 +48,14 @@
 
 (define %user-module
   ;; Module in which the machine description file is loaded.
-  (let ((module (make-fresh-user-module)))
-    (for-each (lambda (iface)
-                (module-use! module (resolve-interface iface)))
-              '((gnu system)
-                (gnu services)
-                (gnu system shadow)))
-    module))
+  (make-user-module '((gnu system)
+                      (gnu services)
+                      (gnu system shadow))))
 
 (define (read-operating-system file)
   "Read the operating-system declaration from FILE and return it."
-  ;; TODO: Factorize.
-  (catch #t
-    (lambda ()
-      ;; Avoid ABI incompatibility with the <operating-system> record.
-      (set! %fresh-auto-compile #t)
+  (load* file %user-module))
 
-      (save-module-excursion
-       (lambda ()
-         (set-current-module %user-module)
-         (primitive-load file))))
-    (lambda args
-      (report-load-error file args))))
 
 
 ;;;
diff --git a/guix/ui.scm b/guix/ui.scm
index 911e5ee868..920355fbb5 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -48,6 +48,8 @@
             P_
             report-error
             leave
+            make-user-module
+            load*
             report-load-error
             warn-about-load-error
             show-version-and-exit
@@ -133,6 +135,28 @@ messages."
     (report-error args ...)
     (exit 1)))
 
+(define (make-user-module modules)
+  "Return a new user module with the additional MODULES loaded."
+  ;; Module in which the machine description file is loaded.
+  (let ((module (make-fresh-user-module)))
+    (for-each (lambda (iface)
+                (module-use! module (resolve-interface iface)))
+              modules)
+    module))
+
+(define (load* file user-module)
+  "Load the user provided Scheme source code FILE."
+  (catch #t
+    (lambda ()
+      (set! %fresh-auto-compile #t)
+
+      (save-module-excursion
+       (lambda ()
+         (set-current-module user-module)
+         (primitive-load file))))
+    (lambda args
+      (report-load-error file args))))
+
 (define (report-load-error file args)
   "Report the failure to load FILE, a user-provided Scheme file, and exit.
 ARGS is the list of arguments received by the 'throw' handler."
-- 
cgit 1.4.1