aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--doc/guix.texi22
-rw-r--r--guix/modules.scm155
-rw-r--r--tests/modules.scm45
4 files changed, 224 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 165dfe9727..1a34e0d5ca 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/doc/guix.texi b/doc/guix.texi
index d6c041862d..b6ca34a2f3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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}
diff --git a/guix/modules.scm b/guix/modules.scm
new file mode 100644
index 0000000000..24f613ff4e
--- /dev/null
+++ b/guix/modules.scm
@@ -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
diff --git a/tests/modules.scm b/tests/modules.scm
new file mode 100644
index 0000000000..04945e531b
--- /dev/null
+++ b/tests/modules.scm
@@ -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)