walk-packages.scm

(define (gather-packages package)
  (define (%gather-packages lst package)
    (let ((pkg (if (package? package)
		   package
		   (name->package package))))
      (let ((sub-packages (%record-ref pkg 2)))
	(if (null? sub-packages)
	    (cons pkg lst)
	    (append (cons pkg lst)
		    (concatenate (map (lambda (child)
					(gather-packages child))
				      sub-packages)))))))
  (%gather-packages '() package))

(define (on-pkg-env f pkg)
  (cons pkg (f (->environment pkg))))

(define (on-all-sub-pkg-envs f pkg)
  (map (lambda (p) (on-pkg-env f p)) (gather-packages pkg)))

(define (find-name-in-pkg name startpkg)
  (let ((pkg-names (on-all-sub-pkg-envs environment-bound-names startpkg)))
    (let loop ((pkgs pkg-names))
      (if (null? pkgs)
	  #f
	  (let ((pkg (car pkgs)))
	    (if (member name (cdr pkg))
		(car pkg)
		(loop (cdr pkgs))))))))

;(find-name-in-pkg 'expander-item/expander system-global-package)
;Value 5: #[package 5 (runtime syntax)]

;(find-name-in-pkg 'strip-keyword-value-item system-global-package)
;Value 2: #[package 2 (runtime syntax classify)]

;(find-name-in-pkg 'expander-item/environment system-global-package)
;#f