kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

Add (guix modules).

Browse Source 
* guix/modules.scm, tests/modules.scm: New files.
* Makefile.am (MODULES, SCM_TESTS): Add them.
* doc/guix.texi (G-Expressions): Add an example of
'source-module-closure'.
This commit is contained in:
Ludovic Courtès 2016-09-04 23:41:53 +02:00
parent 2ff0da0257
commit 7ca87354db
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 224 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -41,6 +41,7 @@ MODULES = \
guix/combinators.scm \
guix/utils.scm \
guix/sets.scm \
guix/modules.scm \
guix/download.scm \
guix/git-download.scm \
guix/hg-download.scm \
@ -222,6 +223,7 @@ SCM_TESTS = \
tests/pk-crypto.scm \
tests/pki.scm \
tests/sets.scm \
tests/modules.scm \
tests/gnu-maintenance.scm \
tests/substitute.scm \
tests/builders.scm \

22
doc/guix.texi
View File

@ -3825,6 +3825,28 @@ In this example, the @code{(guix build utils)} module is automatically
pulled into the isolated build environment of our gexp, such that
@code{(use-modules (guix build utils))} works as expected.
@cindex module closure
@findex source-module-closure
Usually you want the @emph{closure} of the module to be imported---i.e.,
the module itself and all the modules it depends on---rather than just
the module; failing to do that, attempts to use the module will fail
because of missing dependent modules. The @code{source-module-closure}
procedure computes the closure of a module by looking at its source file
headers, which comes in handy in this case:
@example
(use-modules (guix modules)) ;for 'source-module-closure'
(with-imported-modules (source-module-closure
'((guix build utils)
(gnu build vm)))
(gexp->derivation "something-with-vms"
#~(begin
(use-modules (guix build utils)
(gnu build vm))
@dots{})))
@end example
The syntactic form to construct gexps is summarized below.
@deffn {Scheme Syntax} #~@var{exp}

155
guix/modules.scm Normal file
View File

@ -0,0 +1,155 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix modules)
#:use-module ((guix utils) #:select (memoize))
#:use-module (guix sets)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (source-module-closure
live-module-closure
guix-module-name?))
;;; Commentary:
;;;
;;; This module provides introspection tools for Guile modules at the source
;;; level. Namely, it allows you to determine the closure of a module; it
;;; does so just by reading the 'define-module' clause of the module and its
;;; dependencies. This is primarily useful as an argument to
;;; 'with-imported-modules'.
;;;
;;; Code:
(define (colon-symbol? obj)
"Return true if OBJ is a symbol that starts with a colon."
(and (symbol? obj)
(string-prefix? ":" (symbol->string obj))))
(define (colon-symbol->keyword symbol)
"Convert SYMBOL to a keyword after stripping its initial ':'."
(symbol->keyword
(string->symbol (string-drop (symbol->string symbol) 1))))
(define (extract-dependencies clauses)
"Return the list of modules imported according to the given 'define-module'
CLAUSES."
(let loop ((clauses clauses)
(result '()))
(match clauses
(()
(reverse result))
((#:use-module (module (or #:select #:hide #:prefix #:renamer) _)
rest ...)
(loop rest (cons module result)))
((#:use-module module rest ...)
(loop rest (cons module result)))
((#:autoload module _ rest ...)
(loop rest (cons module result)))
(((or #:export #:re-export #:export-syntax #:re-export-syntax
#:replace #:version)
_ rest ...)
(loop rest result))
(((or #:pure #:no-backtrace) rest ...)
(loop rest result))
(((? colon-symbol? symbol) rest ...)
(loop (cons (colon-symbol->keyword symbol) rest)
result)))))
(define module-file-dependencies
(memoize
(lambda (file)
"Return the list of the names of modules that the Guile module in FILE
depends on."
(call-with-input-file file
(lambda (port)
(match (read port)
(('define-module name clauses ...)
(extract-dependencies clauses))
;; XXX: R6RS 'library' form is ignored.
(_
'())))))))
(define (module-name->file-name module)
"Return the file name for MODULE."
(string-append (string-join (map symbol->string module) "/")
".scm"))
(define (guix-module-name? name)
"Return true if NAME (a list of symbols) denotes a Guix or GuixSD module."
(match name
(('guix _ ...) #t)
(('gnu _ ...) #t)
(_ #f)))
(define* (source-module-dependencies module #:optional (load-path %load-path))
"Return the modules used by MODULE by looking at its source code."
;; The (system syntax) module is a special-case because it has no
;; corresponding source file (as of Guile 2.0.)
(if (equal? module '(system syntax))
'()
(module-file-dependencies
(search-path load-path
(module-name->file-name module)))))
(define* (module-closure modules
#:key
(select? guix-module-name?)
(dependencies source-module-dependencies))
"Return the closure of MODULES, calling DEPENDENCIES to determine the list
of modules used by a given module. MODULES and the result are a list of Guile
module names. Only modules that match SELECT? are considered."
(let loop ((modules modules)
(result '())
(visited (set)))
(match modules
(()
(reverse result))
((module rest ...)
(cond ((set-contains? visited module)
(loop rest result visited))
((select? module)
(loop (append (dependencies module) rest)
(cons module result)
(set-insert module visited)))
(else
(loop rest result visited)))))))
(define* (source-module-closure modules
#:optional (load-path %load-path)
#:key (select? guix-module-name?))
"Return the closure of MODULES by reading 'define-module' forms in their
source code. MODULES and the result are a list of Guile module names. Only
modules that match SELECT? are considered."
(module-closure modules
#:dependencies (cut source-module-dependencies <> load-path)
#:select? select?))
(define* (live-module-closure modules
#:key (select? guix-module-name?))
"Return the closure of MODULES, determined by looking at live (loaded)
module information. MODULES and the result are a list of Guile module names.
Only modules that match SELECT? are considered."
(define (dependencies module)
(map module-name
(delq the-scm-module (module-uses (resolve-module module)))))
(module-closure modules
#:dependencies dependencies
#:select? select?))
;;; modules.scm ends here

45
tests/modules.scm Normal file
View File

@ -0,0 +1,45 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-modules)
#:use-module (guix modules)
#:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
(test-begin "modules")
(test-assert "closure of (guix build gnu-build-system)"
(lset= equal?
(live-module-closure '((guix build gnu-build-system)))
(source-module-closure '((guix build gnu-build-system)))
%gnu-build-system-modules
(source-module-closure %gnu-build-system-modules)
(live-module-closure %gnu-build-system-modules)))
(test-assert "closure of (gnu build install)"
(lset= equal?
(live-module-closure '((gnu build install)))
(source-module-closure '((gnu build install)))))
(test-assert "closure of (gnu build vm)"
(lset= equal?
(live-module-closure '((gnu build vm)))
(source-module-closure '((gnu build vm)))))
(test-end)