Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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
Add Comment
Please, Sign In to add comment