You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

186 lines
6.9 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  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.
  10. ;;;
  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.
  15. ;;;
  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/>.
  18. (define-module (guix modules)
  19. #:use-module (guix memoization)
  20. #:use-module (guix sets)
  21. #:use-module (srfi srfi-26)
  22. #:use-module (srfi srfi-34)
  23. #:use-module (srfi srfi-35)
  24. #:use-module (ice-9 match)
  25. #:export (missing-dependency-error?
  26. missing-dependency-module
  27. missing-dependency-search-path
  28. file-name->module-name
  29. module-name->file-name
  30. source-module-dependencies
  31. source-module-closure
  32. live-module-closure
  33. guix-module-name?))
  34. ;;; Commentary:
  35. ;;;
  36. ;;; This module provides introspection tools for Guile modules at the source
  37. ;;; level. Namely, it allows you to determine the closure of a module; it
  38. ;;; does so just by reading the 'define-module' clause of the module and its
  39. ;;; dependencies. This is primarily useful as an argument to
  40. ;;; 'with-imported-modules'.
  41. ;;;
  42. ;;; Code:
  43. ;; The error corresponding to a missing module.
  44. (define-condition-type &missing-dependency-error &error
  45. missing-dependency-error?
  46. (module missing-dependency-module)
  47. (search-path missing-dependency-search-path))
  48. (define (colon-symbol? obj)
  49. "Return true if OBJ is a symbol that starts with a colon."
  50. (and (symbol? obj)
  51. (string-prefix? ":" (symbol->string obj))))
  52. (define (colon-symbol->keyword symbol)
  53. "Convert SYMBOL to a keyword after stripping its initial ':'."
  54. (symbol->keyword
  55. (string->symbol (string-drop (symbol->string symbol) 1))))
  56. (define (extract-dependencies clauses)
  57. "Return the list of modules imported according to the given 'define-module'
  58. CLAUSES."
  59. (let loop ((clauses clauses)
  60. (result '()))
  61. (match clauses
  62. (()
  63. (reverse result))
  64. ((#:use-module (module (or #:select #:hide #:prefix #:renamer) _)
  65. rest ...)
  66. (loop rest (cons module result)))
  67. ((#:use-module module rest ...)
  68. (loop rest (cons module result)))
  69. ((#:autoload module _ rest ...)
  70. (loop rest (cons module result)))
  71. (((or #:export #:re-export #:export-syntax #:re-export-syntax
  72. #:replace #:version)
  73. _ rest ...)
  74. (loop rest result))
  75. (((or #:pure #:no-backtrace) rest ...)
  76. (loop rest result))
  77. (((? colon-symbol? symbol) rest ...)
  78. (loop (cons (colon-symbol->keyword symbol) rest)
  79. result)))))
  80. (define module-file-dependencies
  81. (mlambda (file)
  82. "Return the list of the names of modules that the Guile module in FILE
  83. depends on."
  84. (call-with-input-file file
  85. (lambda (port)
  86. (match (read port)
  87. (('define-module name clauses ...)
  88. (extract-dependencies clauses))
  89. ;; XXX: R6RS 'library' form is ignored.
  90. (_
  91. '()))))))
  92. (define file-name->module-name
  93. (let ((not-slash (char-set-complement (char-set #\/))))
  94. (lambda (file)
  95. "Return the module name (a list of symbols) corresponding to FILE."
  96. (map string->symbol
  97. (string-tokenize (string-drop-right file 4) not-slash)))))
  98. (define (module-name->file-name module)
  99. "Return the file name for MODULE."
  100. (string-append (string-join (map symbol->string module) "/")
  101. ".scm"))
  102. (define (guix-module-name? name)
  103. "Return true if NAME (a list of symbols) denotes a Guix or GuixSD module."
  104. (match name
  105. (('guix _ ...) #t)
  106. (('gnu _ ...) #t)
  107. (_ #f)))
  108. (define %source-less-modules
  109. ;; These are modules that have no corresponding source files or a source
  110. ;; file different from what you'd expect.
  111. '((system syntax) ;2.0, defined in boot-9
  112. (ice-9 ports internal) ;2.2, defined in (ice-9 ports)
  113. (system syntax internal))) ;2.2, defined in boot-9
  114. (define* (source-module-dependencies module #:optional (load-path %load-path))
  115. "Return the modules used by MODULE by looking at its source code."
  116. (if (member module %source-less-modules)
  117. '()
  118. (match (search-path load-path (module-name->file-name module))
  119. ((? string? file)
  120. (module-file-dependencies file))
  121. (#f
  122. (raise (condition (&missing-dependency-error
  123. (module module)
  124. (search-path load-path))))))))
  125. (define* (module-closure modules
  126. #:key
  127. (select? guix-module-name?)
  128. (dependencies source-module-dependencies))
  129. "Return the closure of MODULES, calling DEPENDENCIES to determine the list
  130. of modules used by a given module. MODULES and the result are a list of Guile
  131. module names. Only modules that match SELECT? are considered."
  132. (let loop ((modules modules)
  133. (result '())
  134. (visited (set)))
  135. (match modules
  136. (()
  137. (reverse result))
  138. ((module rest ...)
  139. (cond ((set-contains? visited module)
  140. (loop rest result visited))
  141. ((select? module)
  142. (loop (append (dependencies module) rest)
  143. (cons module result)
  144. (set-insert module visited)))
  145. (else
  146. (loop rest result visited)))))))
  147. (define* (source-module-closure modules
  148. #:optional (load-path %load-path)
  149. #:key (select? guix-module-name?))
  150. "Return the closure of MODULES by reading 'define-module' forms in their
  151. source code. MODULES and the result are a list of Guile module names. Only
  152. modules that match SELECT? are considered."
  153. (module-closure modules
  154. #:dependencies (cut source-module-dependencies <> load-path)
  155. #:select? select?))
  156. (define* (live-module-closure modules
  157. #:key (select? guix-module-name?))
  158. "Return the closure of MODULES, determined by looking at live (loaded)
  159. module information. MODULES and the result are a list of Guile module names.
  160. Only modules that match SELECT? are considered."
  161. (define (dependencies module)
  162. (map module-name
  163. (delq the-scm-module (module-uses (resolve-module module)))))
  164. (module-closure modules
  165. #:dependencies dependencies
  166. #:select? select?))
  167. ;;; modules.scm ends here