home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / ice-9 / ls.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  4.5 KB  |  122 lines
  1. ;;;; ls.scm --- functions for browsing modules
  2. ;;;;
  3. ;;;;     Copyright (C) 1995, 1996, 1997, 1999, 2001 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This program is free software; you can redistribute it and/or modify
  6. ;;;; it under the terms of the GNU General Public License as published by
  7. ;;;; the Free Software Foundation; either version 2, or (at your option)
  8. ;;;; any later version.
  9. ;;;; 
  10. ;;;; This program 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
  13. ;;;; GNU General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU General Public License
  16. ;;;; along with this software; see the file COPYING.  If not, write to
  17. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18. ;;;; Boston, MA 02111-1307 USA
  19. ;;;;
  20. ;;;; As a special exception, the Free Software Foundation gives permission
  21. ;;;; for additional uses of the text contained in its release of GUILE.
  22. ;;;;
  23. ;;;; The exception is that, if you link the GUILE library with other files
  24. ;;;; to produce an executable, this does not by itself cause the
  25. ;;;; resulting executable to be covered by the GNU General Public License.
  26. ;;;; Your use of that executable is in no way restricted on account of
  27. ;;;; linking the GUILE library code into it.
  28. ;;;;
  29. ;;;; This exception does not however invalidate any other reasons why
  30. ;;;; the executable file might be covered by the GNU General Public License.
  31. ;;;;
  32. ;;;; This exception applies only to the code released by the
  33. ;;;; Free Software Foundation under the name GUILE.  If you copy
  34. ;;;; code from other Free Software Foundation releases into a copy of
  35. ;;;; GUILE, as the General Public License permits, the exception does
  36. ;;;; not apply to the code that you add in this way.  To avoid misleading
  37. ;;;; anyone as to the status of such modified files, you must delete
  38. ;;;; this exception notice from them.
  39. ;;;;
  40. ;;;; If you write modifications of your own for GUILE, it is your choice
  41. ;;;; whether to permit this exception to apply to your modifications.
  42. ;;;; If you do not wish that, delete this exception notice.
  43. ;;;; 
  44.  
  45. (define-module (ice-9 ls)
  46.   :use-module (ice-9 common-list)
  47.   :export (local-definitions-in definitions-in ls lls
  48.        recursive-local-define))
  49.  
  50. ;;;;
  51. ;;;    local-definitions-in root name
  52. ;;;        Returns a list of names defined locally in the named
  53. ;;;        subdirectory of root.
  54. ;;;    definitions-in root name
  55. ;;;        Returns a list of all names defined in the named
  56. ;;;        subdirectory of root.  The list includes alll locally
  57. ;;;        defined names as well as all names inherited from a
  58. ;;;        member of a use-list.
  59. ;;;
  60. ;;; A convenient interface for examining the nature of things:
  61. ;;;
  62. ;;;    ls . various-names
  63. ;;;
  64. ;;;        With no arguments, return a list of definitions in
  65. ;;;        `(current-module)'.
  66. ;;;
  67. ;;;        With just one argument, interpret that argument as the
  68. ;;;        name of a subdirectory of the current module and
  69. ;;;        return a list of names defined there.
  70. ;;;
  71. ;;;        With more than one argument, still compute
  72. ;;;        subdirectory lists, but return a list:
  73. ;;;            ((<subdir-name> . <names-defined-there>)
  74. ;;;             (<subdir-name> . <names-defined-there>)
  75. ;;;             ...)
  76. ;;;
  77. ;;;     lls . various-names
  78. ;;;
  79. ;;;        Analogous to `ls', but with local definitions only.
  80.  
  81. (define (local-definitions-in root names)
  82.   (let ((m (nested-ref root names))
  83.     (answer '()))
  84.     (if (not (module? m))
  85.     (set! answer m)
  86.     (module-for-each (lambda (k v) (set! answer (cons k answer))) m))
  87.     answer))
  88.  
  89. (define (definitions-in root names)
  90.   (let ((m (nested-ref root names)))
  91.     (if (not (module? m))
  92.     m
  93.     (reduce union
  94.         (cons (local-definitions-in m  '())
  95.               (map (lambda (m2) (definitions-in m2 '()))
  96.                (module-uses m)))))))
  97.  
  98. (define (ls . various-refs)
  99.   (if (pair? various-refs)
  100.        (if (cdr various-refs)
  101.        (map (lambda (ref)
  102.           (cons ref (definitions-in (current-module) ref)))
  103.         various-refs)
  104.       (definitions-in (current-module) (car various-refs)))
  105.       (definitions-in (current-module) '())))
  106.  
  107. (define (lls . various-refs)
  108.   (if (pair? various-refs)
  109.        (if (cdr various-refs)
  110.        (map (lambda (ref)
  111.           (cons ref (local-definitions-in (current-module) ref)))
  112.         various-refs)
  113.       (local-definitions-in (current-module) (car various-refs)))
  114.       (local-definitions-in (current-module) '())))
  115.  
  116. (define (recursive-local-define name value)
  117.   (let ((parent (reverse! (cdr (reverse name)))))
  118.     (and parent (make-modules-in (current-module) parent))
  119.     (local-define name value)))
  120.  
  121. ;;; ls.scm ends here
  122.