guile18/ice-9/ls.scm

   1 ;;;; ls.scm --- functions for browsing modules
   2 ;;;;
   3 ;;;;    Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 2.1 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 ;;;;
  19 \f
  20 (define-module (ice-9 ls)
  21   :use-module (ice-9 common-list)
  22   :export (local-definitions-in definitions-in ls lls
  23            recursive-local-define))
  24
  25 ;;;;
  26 ;;;     local-definitions-in root name
  27 ;;;             Returns a list of names defined locally in the named
  28 ;;;             subdirectory of root.
  29 ;;;     definitions-in root name
  30 ;;;             Returns a list of all names defined in the named
  31 ;;;             subdirectory of root.  The list includes alll locally
  32 ;;;             defined names as well as all names inherited from a
  33 ;;;             member of a use-list.
  34 ;;;
  35 ;;; A convenient interface for examining the nature of things:
  36 ;;;
  37 ;;;     ls . various-names
  38 ;;;
  39 ;;;             With no arguments, return a list of definitions in
  40 ;;;             `(current-module)'.
  41 ;;;
  42 ;;;             With just one argument, interpret that argument as the
  43 ;;;             name of a subdirectory of the current module and
  44 ;;;             return a list of names defined there.
  45 ;;;
  46 ;;;             With more than one argument, still compute
  47 ;;;             subdirectory lists, but return a list:
  48 ;;;                     ((<subdir-name> . <names-defined-there>)
  49 ;;;                      (<subdir-name> . <names-defined-there>)
  50 ;;;                      ...)
  51 ;;;
  52 ;;;     lls . various-names
  53 ;;;
  54 ;;;             Analogous to `ls', but with local definitions only.
  55
  56 (define (local-definitions-in root names)
  57   (let ((m (nested-ref root names))
  58         (answer '()))
  59     (if (not (module? m))
  60         (set! answer m)
  61         (module-for-each (lambda (k v) (set! answer (cons k answer))) m))
  62     answer))
  63
  64 (define (definitions-in root names)
  65   (let ((m (nested-ref root names)))
  66     (if (not (module? m))
  67         m
  68         (reduce union
  69                 (cons (local-definitions-in m  '())
  70                       (map (lambda (m2) (definitions-in m2 '()))
  71                            (module-uses m)))))))
  72
  73 (define (ls . various-refs)
  74   (if (pair? various-refs)
  75        (if (cdr various-refs)
  76            (map (lambda (ref)
  77                   (cons ref (definitions-in (current-module) ref)))
  78                 various-refs)
  79           (definitions-in (current-module) (car various-refs)))
  80       (definitions-in (current-module) '())))
  81
  82 (define (lls . various-refs)
  83   (if (pair? various-refs)
  84        (if (cdr various-refs)
  85            (map (lambda (ref)
  86                   (cons ref (local-definitions-in (current-module) ref)))
  87                 various-refs)
  88           (local-definitions-in (current-module) (car various-refs)))
  89       (local-definitions-in (current-module) '())))
  90
  91 (define (recursive-local-define name value)
  92   (let ((parent (reverse! (cdr (reverse name)))))
  93     (and parent (make-modules-in (current-module) parent))
  94     (local-define name value)))
  95
  96 ;;; ls.scm ends here