~ruther/guix-local

7ea1432e22b42969ff0d078e68f5cb55a75b1aca — David Thompson 11 years ago d620ea8
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*'.
2 files changed, 28 insertions(+), 18 deletions(-)

M guix/scripts/system.scm
M guix/ui.scm
M guix/scripts/system.scm => guix/scripts/system.scm +4 -18
@@ 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))))


;;;

M guix/ui.scm => guix/ui.scm +24 -0
@@ 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."