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*'.
This commit is contained in:
David Thompson 2015-05-18 07:49:44 -04:00
parent d620ea889c
commit 7ea1432e22
2 changed files with 28 additions and 18 deletions

View File

@ -48,28 +48,14 @@
(define %user-module (define %user-module
;; Module in which the machine description file is loaded. ;; Module in which the machine description file is loaded.
(let ((module (make-fresh-user-module))) (make-user-module '((gnu system)
(for-each (lambda (iface) (gnu services)
(module-use! module (resolve-interface iface))) (gnu system shadow))))
'((gnu system)
(gnu services)
(gnu system shadow)))
module))
(define (read-operating-system file) (define (read-operating-system file)
"Read the operating-system declaration from FILE and return it." "Read the operating-system declaration from FILE and return it."
;; TODO: Factorize. (load* file %user-module))
(catch #t
(lambda ()
;; Avoid ABI incompatibility with the <operating-system> record.
(set! %fresh-auto-compile #t)
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(primitive-load file))))
(lambda args
(report-load-error file args))))
;;; ;;;

View File

@ -48,6 +48,8 @@
P_ P_
report-error report-error
leave leave
make-user-module
load*
report-load-error report-load-error
warn-about-load-error warn-about-load-error
show-version-and-exit show-version-and-exit
@ -133,6 +135,28 @@ messages."
(report-error args ...) (report-error args ...)
(exit 1))) (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) (define (report-load-error file args)
"Report the failure to load FILE, a user-provided Scheme file, and exit. "Report the failure to load FILE, a user-provided Scheme file, and exit.
ARGS is the list of arguments received by the 'throw' handler." ARGS is the list of arguments received by the 'throw' handler."