link-debug.scm 1.1 KB

123456789101112131415161718192021222324252627282930313233343536373839
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Richard Kelsey, Jonathan Rees
  3. ; Stuff for debugging new images:
  4. (define (ev form package)
  5. (invoke-template (compile-form form package)
  6. (package-uid package)))
  7. ; If desired, this definition of invoke-template can be replaced by
  8. ; something that starts up a different virtual machine.
  9. (define (invoke-template template env . args)
  10. (apply (make-closure template env)
  11. args))
  12. ; Utility for tracking down uses of variables
  13. (define (who-uses name proc)
  14. (let recur ((tem (closure-template proc))
  15. (path '()))
  16. (let loop ((i 0))
  17. (if (< i (template-length tem))
  18. (let ((thing (template-ref tem i))
  19. (down (lambda (tem)
  20. (recur tem (cons (or (template-ref tem 1) i) path)))))
  21. (cond ((template? thing)
  22. (down thing))
  23. ((location? thing)
  24. (if (eq? (location-name thing) name)
  25. (begin (write path) (newline))))
  26. ((closure? thing)
  27. (down (closure-template thing))))
  28. (loop (+ i 1)))))))