aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-05-18 07:49:44 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-05-20 12:13:04 -0400
commit7ea1432e22b42969ff0d078e68f5cb55a75b1aca (patch)
treebdf7b29e5743a670ad0b85421dd93610998a274b
parentd620ea889cd6ea75430258b613d729900f440abc (diff)
downloadpatches-7ea1432e22b42969ff0d078e68f5cb55a75b1aca.tar
patches-7ea1432e22b42969ff0d078e68f5cb55a75b1aca.tar.gz
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*'.
-rw-r--r--guix/scripts/system.scm22
-rw-r--r--guix/ui.scm24
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."