diff options
author | David Thompson <dthompson2@worcester.edu> | 2015-05-18 07:49:44 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2015-05-20 12:13:04 -0400 |
commit | 7ea1432e22b42969ff0d078e68f5cb55a75b1aca (patch) | |
tree | bdf7b29e5743a670ad0b85421dd93610998a274b | |
parent | d620ea889cd6ea75430258b613d729900f440abc (diff) | |
download | guix-7ea1432e22b42969ff0d078e68f5cb55a75b1aca.tar guix-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.scm | 22 | ||||
-rw-r--r-- | 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." |