summaryrefslogtreecommitdiff
path: root/guix/modules.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-09-04 23:41:53 +0200
committerLudovic Courtès <ludo@gnu.org>2016-09-05 00:06:47 +0200
commit7ca87354db53fd1e1a7a3dfeddb9a598ea064bbe (patch)
treeb33102eb8ca8cfb2999f0da2f3d78acf0f1b80e7 /guix/modules.scm
parent2ff0da025745dd4ddce45d34c89fdf39190f9104 (diff)
Add (guix modules).
* 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'.
Diffstat (limited to 'guix/modules.scm')
-rw-r--r--guix/modules.scm155
1 files changed, 155 insertions, 0 deletions
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