Browse Source

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*'.
version-0.8.3
David Thompson 7 years ago
parent
commit
7ea1432e22
  1. 22
      guix/scripts/system.scm
  2. 24
      guix/ui.scm

22
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))))
;;;

24
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."

Loading…
Cancel
Save