Guest User

Untitled

a guest
Jun 18th, 2018
105
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.13 KB | None | 0 0
  1. (define (gather-packages package)
  2. (define (%gather-packages lst package)
  3. (let ((pkg (if (package? package)
  4. package
  5. (name->package package))))
  6. (let ((sub-packages (%record-ref pkg 2)))
  7. (if (null? sub-packages)
  8. (cons pkg lst)
  9. (append (cons pkg lst)
  10. (concatenate (map (lambda (child)
  11. (gather-packages child))
  12. sub-packages)))))))
  13. (%gather-packages '() package))
  14.  
  15. (define (on-pkg-env f pkg)
  16. (cons pkg (f (->environment pkg))))
  17.  
  18. (define (on-all-sub-pkg-envs f pkg)
  19. (map (lambda (p) (on-pkg-env f p)) (gather-packages pkg)))
  20.  
  21. (define (find-name-in-pkg name startpkg)
  22. (let ((pkg-names (on-all-sub-pkg-envs environment-bound-names startpkg)))
  23. (let loop ((pkgs pkg-names))
  24. (if (null? pkgs)
  25. #f
  26. (let ((pkg (car pkgs)))
  27. (if (member name (cdr pkg))
  28. (car pkg)
  29. (loop (cdr pkgs))))))))
  30.  
  31. ;(find-name-in-pkg 'expander-item/expander system-global-package)
  32. ;Value 5: #[package 5 (runtime syntax)]
  33.  
  34. ;(find-name-in-pkg 'strip-keyword-value-item system-global-package)
  35. ;Value 2: #[package 2 (runtime syntax classify)]
  36.  
  37. ;(find-name-in-pkg 'expander-item/environment system-global-package)
  38. ;#f
Add Comment
Please, Sign In to add comment