mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
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:
parent
d620ea889c
commit
7ea1432e22
2 changed files with 28 additions and 18 deletions
|
@ -48,28 +48,14 @@ (define-module (guix scripts system)
|
|||
|
||||
(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))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
24
guix/ui.scm
24
guix/ui.scm
|
@ -48,6 +48,8 @@ (define-module (guix ui)
|
|||
P_
|
||||
report-error
|
||||
leave
|
||||
make-user-module
|
||||
load*
|
||||
report-load-error
|
||||
warn-about-load-error
|
||||
show-version-and-exit
|
||||
|
@ -133,6 +135,28 @@ (define-syntax-rule (leave args ...)
|
|||
(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."
|
||||
|
|
Loading…
Reference in a new issue