1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (guix modules)
20 #:use-module (guix memoization)
21 #:use-module (guix sets)
22 #:use-module (srfi srfi-26)
23 #:use-module (ice-9 match)
24 #:export (source-module-closure
30 ;;; This module provides introspection tools for Guile modules at the source
31 ;;; level. Namely, it allows you to determine the closure of a module; it
32 ;;; does so just by reading the 'define-module' clause of the module and its
33 ;;; dependencies. This is primarily useful as an argument to
34 ;;; 'with-imported-modules'.
38 (define (colon-symbol? obj)
39 "Return true if OBJ is a symbol that starts with a colon."
41 (string-prefix? ":" (symbol->string obj))))
43 (define (colon-symbol->keyword symbol)
44 "Convert SYMBOL to a keyword after stripping its initial ':'."
46 (string->symbol (string-drop (symbol->string symbol) 1))))
48 (define (extract-dependencies clauses)
49 "Return the list of modules imported according to the given 'define-module'
51 (let loop ((clauses clauses)
56 ((#:use-module (module (or #:select #:hide #:prefix #:renamer) _)
58 (loop rest (cons module result)))
59 ((#:use-module module rest ...)
60 (loop rest (cons module result)))
61 ((#:autoload module _ rest ...)
62 (loop rest (cons module result)))
63 (((or #:export #:re-export #:export-syntax #:re-export-syntax
67 (((or #:pure #:no-backtrace) rest ...)
69 (((? colon-symbol? symbol) rest ...)
70 (loop (cons (colon-symbol->keyword symbol) rest)
73 (define module-file-dependencies
75 "Return the list of the names of modules that the Guile module in FILE
77 (call-with-input-file file
80 (('define-module name clauses ...)
81 (extract-dependencies clauses))
82 ;; XXX: R6RS 'library' form is ignored.
86 (define (module-name->file-name module)
87 "Return the file name for MODULE."
88 (string-append (string-join (map symbol->string module) "/")
91 (define (guix-module-name? name)
92 "Return true if NAME (a list of symbols) denotes a Guix or GuixSD module."
98 (define* (source-module-dependencies module #:optional (load-path %load-path))
99 "Return the modules used by MODULE by looking at its source code."
100 ;; The (system syntax) module is a special-case because it has no
101 ;; corresponding source file (as of Guile 2.0.)
102 (if (equal? module '(system syntax))
104 (module-file-dependencies
105 (search-path load-path
106 (module-name->file-name module)))))
108 (define* (module-closure modules
110 (select? guix-module-name?)
111 (dependencies source-module-dependencies))
112 "Return the closure of MODULES, calling DEPENDENCIES to determine the list
113 of modules used by a given module. MODULES and the result are a list of Guile
114 module names. Only modules that match SELECT? are considered."
115 (let loop ((modules modules)
122 (cond ((set-contains? visited module)
123 (loop rest result visited))
125 (loop (append (dependencies module) rest)
127 (set-insert module visited)))
129 (loop rest result visited)))))))
131 (define* (source-module-closure modules
132 #:optional (load-path %load-path)
133 #:key (select? guix-module-name?))
134 "Return the closure of MODULES by reading 'define-module' forms in their
135 source code. MODULES and the result are a list of Guile module names. Only
136 modules that match SELECT? are considered."
137 (module-closure modules
138 #:dependencies (cut source-module-dependencies <> load-path)
141 (define* (live-module-closure modules
142 #:key (select? guix-module-name?))
143 "Return the closure of MODULES, determined by looking at live (loaded)
144 module information. MODULES and the result are a list of Guile module names.
145 Only modules that match SELECT? are considered."
146 (define (dependencies module)
148 (delq the-scm-module (module-uses (resolve-module module)))))
150 (module-closure modules
151 #:dependencies dependencies
154 ;;; modules.scm ends here