1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

nested module fixen to (ice-9 ls)

* module/ice-9/ls.scm (local-definitions-in, definitions-in): Use nested
  module procedures, as appropriate.
  (recursive-local-define): Fix attempt to treat null as false. Whoops..
This commit is contained in:
Andy Wingo 2010-04-23 16:03:23 +02:00
parent 635a8b36b1
commit 28b8c785e7

View file

@ -1,6 +1,6 @@
;;;; ls.scm --- functions for browsing modules ;;;; ls.scm --- functions for browsing modules
;;;; ;;;;
;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -54,21 +54,19 @@
;;; Analogous to `ls', but with local definitions only. ;;; Analogous to `ls', but with local definitions only.
(define (local-definitions-in root names) (define (local-definitions-in root names)
(let ((m (nested-ref root names)) (let ((m (nested-ref-module root names)))
(answer '())) (if m
(if (not (module? m)) (module-map (lambda (k v) k) m)
(set! answer m) (nested-ref root names))))
(module-for-each (lambda (k v) (set! answer (cons k answer))) m))
answer))
(define (definitions-in root names) (define (definitions-in root names)
(let ((m (nested-ref root names))) (let ((m (nested-ref-module root names)))
(if (not (module? m)) (if m
m
(reduce union (reduce union
(cons (local-definitions-in m '()) (cons (local-definitions-in m '())
(map (lambda (m2) (definitions-in m2 '())) (map (lambda (m2) (definitions-in m2 '()))
(module-uses m))))))) (module-uses m))))
(nested-ref root names))))
(define (ls . various-refs) (define (ls . various-refs)
(if (pair? various-refs) (if (pair? various-refs)
@ -90,7 +88,7 @@
(define (recursive-local-define name value) (define (recursive-local-define name value)
(let ((parent (reverse! (cdr (reverse name))))) (let ((parent (reverse! (cdr (reverse name)))))
(and parent (make-modules-in (current-module) parent)) (module-define! (make-modules-in (current-module) parent)
(local-define name value))) name value)))
;;; ls.scm ends here ;;; ls.scm ends here