1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2017, 2018 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 (srfi srfi-34)
24 #:use-module (srfi srfi-35)
25 #:use-module (ice-9 match)
26 #:export (missing-dependency-error?
27 missing-dependency-module
28 missing-dependency-search-path
30 file-name->module-name
31 module-name->file-name
33 source-module-dependencies
40 ;;; This module provides introspection tools for Guile modules at the source
41 ;;; level. Namely, it allows you to determine the closure of a module; it
42 ;;; does so just by reading the 'define-module' clause of the module and its
43 ;;; dependencies. This is primarily useful as an argument to
44 ;;; 'with-imported-modules'.
48 ;; The error corresponding to a missing module.
49 (define-condition-type &missing-dependency-error &error
50 missing-dependency-error?
51 (module missing-dependency-module)
52 (search-path missing-dependency-search-path))
54 (define (colon-symbol? obj)
55 "Return true if OBJ is a symbol that starts with a colon."
57 (string-prefix? ":" (symbol->string obj))))
59 (define (colon-symbol->keyword symbol)
60 "Convert SYMBOL to a keyword after stripping its initial ':'."
62 (string->symbol (string-drop (symbol->string symbol) 1))))
64 (define (extract-dependencies clauses)
65 "Return the list of modules imported according to the given 'define-module'
67 (let loop ((clauses clauses)
72 ((#:use-module (module (or #:select #:hide #:prefix #:renamer) _)
74 (loop rest (cons module result)))
75 ((#:use-module module rest ...)
76 (loop rest (cons module result)))
77 ((#:autoload module _ rest ...)
78 (loop rest (cons module result)))
79 (((or #:export #:re-export #:export-syntax #:re-export-syntax
83 (((or #:pure #:no-backtrace) rest ...)
85 (((? colon-symbol? symbol) rest ...)
86 (loop (cons (colon-symbol->keyword symbol) rest)
89 (define module-file-dependencies
91 "Return the list of the names of modules that the Guile module in FILE
93 (call-with-input-file file
96 (('define-module name clauses ...)
97 (extract-dependencies clauses))
98 ;; XXX: R6RS 'library' form is ignored.
102 (define file-name->module-name
103 (let ((not-slash (char-set-complement (char-set #\/))))
105 "Return the module name (a list of symbols) corresponding to FILE."
107 (string-tokenize (string-drop-right file 4) not-slash)))))
109 (define (module-name->file-name module)
110 "Return the file name for MODULE."
111 (string-append (string-join (map symbol->string module) "/")
114 (define (guix-module-name? name)
115 "Return true if NAME (a list of symbols) denotes a Guix or GuixSD module."
121 (define %source-less-modules
122 ;; These are modules that have no corresponding source files or a source
123 ;; file different from what you'd expect.
124 '((system syntax) ;2.0, defined in boot-9
125 (ice-9 ports internal) ;2.2, defined in (ice-9 ports)
126 (system syntax internal))) ;2.2, defined in boot-9
128 (define* (source-module-dependencies module #:optional (load-path %load-path))
129 "Return the modules used by MODULE by looking at its source code."
130 (if (member module %source-less-modules)
132 (match (search-path load-path (module-name->file-name module))
134 (module-file-dependencies file))
136 (raise (condition (&missing-dependency-error
138 (search-path load-path))))))))
140 (define* (module-closure modules
142 (select? guix-module-name?)
143 (dependencies source-module-dependencies))
144 "Return the closure of MODULES, calling DEPENDENCIES to determine the list
145 of modules used by a given module. MODULES and the result are a list of Guile
146 module names. Only modules that match SELECT? are considered."
147 (let loop ((modules modules)
154 (cond ((set-contains? visited module)
155 (loop rest result visited))
157 (loop (append (dependencies module) rest)
159 (set-insert module visited)))
161 (loop rest result visited)))))))
163 (define* (source-module-closure modules
164 #:optional (load-path %load-path)
165 #:key (select? guix-module-name?))
166 "Return the closure of MODULES by reading 'define-module' forms in their
167 source code. MODULES and the result are a list of Guile module names. Only
168 modules that match SELECT? are considered."
169 (module-closure modules
170 #:dependencies (cut source-module-dependencies <> load-path)
173 (define* (live-module-closure modules
174 #:key (select? guix-module-name?))
175 "Return the closure of MODULES, determined by looking at live (loaded)
176 module information. MODULES and the result are a list of Guile module names.
177 Only modules that match SELECT? are considered."
178 (define (dependencies module)
180 (delq the-scm-module (module-uses (resolve-module module)))))
182 (module-closure modules
183 #:dependencies dependencies
186 ;;; modules.scm ends here