-;;;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997, 2000, 2001, 2003 Free Software Foundation, Inc.
;;;;
-;;;; This program 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 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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 this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-;;;;
-;;;; As a special exception, the Free Software Foundation gives permission
-;;;; for additional uses of the text contained in its release of GUILE.
-;;;;
-;;;; The exception is that, if you link the GUILE library with other files
-;;;; to produce an executable, this does not by itself cause the
-;;;; resulting executable to be covered by the GNU General Public License.
-;;;; Your use of that executable is in no way restricted on account of
-;;;; linking the GUILE library code into it.
-;;;;
-;;;; This exception does not however invalidate any other reasons why
-;;;; the executable file might be covered by the GNU General Public License.
-;;;;
-;;;; This exception applies only to the code released by the
-;;;; Free Software Foundation under the name GUILE. If you copy
-;;;; code from other Free Software Foundation releases into a copy of
-;;;; GUILE, as the General Public License permits, the exception does
-;;;; not apply to the code that you add in this way. To avoid misleading
-;;;; anyone as to the status of such modified files, you must delete
-;;;; this exception notice from them.
-;;;;
-;;;; If you write modifications of your own for GUILE, it is your choice
-;;;; whether to permit this exception to apply to your modifications.
-;;;; If you do not wish that, delete this exception notice.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;;;
\f
(if (zero? (string-length rgx))
"Empty string not allowed"
(let* ((match (make-regexp rgx))
+ (uses (module-uses (current-module)))
(modules (cons (current-module)
- (module-uses (current-module))))
+ (if (and (not (null? uses))
+ (eq? (module-name (car uses))
+ 'duplicates))
+ (cdr uses)
+ uses)))
(separator #\tab)
(shadow (member 'shadow options))
(value (member 'value options)))
(let* ((name (module-name module))
(obarray (module-obarray module)))
;; XXX - should use hash-fold here
- (array-for-each
- (lambda (oblist)
- (for-each
- (lambda (x)
- (cond ((regexp-exec match (symbol->string (car x)))
- (display name)
- (display ": ")
- (display (car x))
- (cond ((variable-bound? (cdr x))
- (let ((val (variable-ref (cdr x))))
- (cond ((or (procedure? val) value)
- (display separator)
- (display val)))))
- (else
- (display separator)
- (display "(unbound)")))
- (if (and shadow
- (not (eq? (module-ref module
- (car x))
- (module-ref (current-module)
- (car x)))))
- (display " shadowed"))
- (newline))))
- oblist))
+ (hash-for-each
+ (lambda (symbol variable)
+ (cond ((regexp-exec match (symbol->string symbol))
+ (display name)
+ (display ": ")
+ (display symbol)
+ (cond ((variable-bound? variable)
+ (let ((val (variable-ref variable)))
+ (cond ((or (procedure? val) value)
+ (display separator)
+ (display val)))))
+ (else
+ (display separator)
+ (display "(unbound)")))
+ (if (and shadow
+ (not (eq? (module-ref module symbol)
+ (module-ref (current-module) symbol))))
+ (display " shadowed"))
+ (newline))))
obarray)))
modules))))
HCoop / bpt / guile.git / blobdiff