From 7ca87354db53fd1e1a7a3dfeddb9a598ea064bbe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 4 Sep 2016 23:41:53 +0200 Subject: 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'. --- guix/modules.scm | 155 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 155 insertions(+) create mode 100644 guix/modules.scm (limited to 'guix/modules.scm') 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 +;;; +;;; 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 . + +(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 -- cgit v1.2.3