guix/modules.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2017 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
  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
  25             live-module-closure
  26             guix-module-name?))
  27
  28 ;;; Commentary:
  29 ;;;
  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'.
  35 ;;;
  36 ;;; Code:
  37
  38 (define (colon-symbol? obj)
  39   "Return true if OBJ is a symbol that starts with a colon."
  40   (and (symbol? obj)
  41        (string-prefix? ":" (symbol->string obj))))
  42
  43 (define (colon-symbol->keyword symbol)
  44   "Convert SYMBOL to a keyword after stripping its initial ':'."
  45   (symbol->keyword
  46    (string->symbol (string-drop (symbol->string symbol) 1))))
  47
  48 (define (extract-dependencies clauses)
  49   "Return the list of modules imported according to the given 'define-module'
  50 CLAUSES."
  51   (let loop ((clauses clauses)
  52              (result  '()))
  53     (match clauses
  54       (()
  55        (reverse result))
  56       ((#:use-module (module (or #:select #:hide #:prefix #:renamer) _)
  57         rest ...)
  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
  64             #:replace #:version)
  65         _ rest ...)
  66        (loop rest result))
  67       (((or #:pure #:no-backtrace) rest ...)
  68        (loop rest result))
  69       (((? colon-symbol? symbol) rest ...)
  70        (loop (cons (colon-symbol->keyword symbol) rest)
  71              result)))))
  72
  73 (define module-file-dependencies
  74   (mlambda (file)
  75     "Return the list of the names of modules that the Guile module in FILE
  76 depends on."
  77     (call-with-input-file file
  78       (lambda (port)
  79         (match (read port)
  80           (('define-module name clauses ...)
  81            (extract-dependencies clauses))
  82           ;; XXX: R6RS 'library' form is ignored.
  83           (_
  84            '()))))))
  85
  86 (define (module-name->file-name module)
  87   "Return the file name for MODULE."
  88   (string-append (string-join (map symbol->string module) "/")
  89                  ".scm"))
  90
  91 (define (guix-module-name? name)
  92   "Return true if NAME (a list of symbols) denotes a Guix or GuixSD module."
  93   (match name
  94     (('guix _ ...) #t)
  95     (('gnu _ ...) #t)
  96     (_ #f)))
  97
  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))
 103       '()
 104       (module-file-dependencies
 105        (search-path load-path
 106                     (module-name->file-name module)))))
 107
 108 (define* (module-closure modules
 109                          #:key
 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)
 116              (result  '())
 117              (visited  (set)))
 118     (match modules
 119       (()
 120        (reverse result))
 121       ((module rest ...)
 122        (cond ((set-contains? visited module)
 123               (loop rest result visited))
 124              ((select? module)
 125               (loop (append (dependencies module) rest)
 126                     (cons module result)
 127                     (set-insert module visited)))
 128              (else
 129               (loop rest result visited)))))))
 130
 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)
 139                   #:select? select?))
 140
 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)
 147     (map module-name
 148          (delq the-scm-module (module-uses (resolve-module module)))))
 149
 150   (module-closure modules
 151                   #:dependencies dependencies
 152                   #:select? select?))
 153
 154 ;;; modules.scm ends here