xref.scm (1378B)
1 ;;;; xref.scm 2 3 4 (define (report-undefined) 5 (let loop ((old undefined) (new '())) 6 (cond ((null? old) 7 (cond ((pair? new) 8 (let ((out (current-error-port))) 9 (display "\nError: access to undefined global variables:\n\n" out) 10 (for-each 11 (lambda (id) 12 (display " " out) 13 (write id out) 14 (display "\n" out)) 15 (sort new symbol<?)) 16 #t)) 17 (else #f))) 18 ((get (car old) 'defined) 19 (loop (cdr old) new)) 20 (else (loop (cdr old) (cons (car old) new)))))) 21 22 (define (xref sections show) 23 (when show 24 (for-each 25 (lambda (defd) (pp `(define ,defd))) 26 (sort defined symbol<?)) 27 (for-each 28 (lambda (refd) 29 (when (or (not (symbol? (get refd 'defined))) sections) 30 (pp refd))) 31 (sort referenced symbol<?)) 32 (for-each 33 (lambda (asgnd) (pp `(set! ,asgnd))) 34 (sort assigned symbol<?))) 35 (and sections 36 (let loop ((us used-sections) (done '())) 37 (cond ((null? us) 38 (when show 39 (for-each 40 (lambda (s) (pp `(section ,s))) 41 (sort done symbol<?))) 42 done) 43 (else 44 (let* ((s (car us)) 45 (done (cons s done))) 46 (let loop2 ((deps (or (get s 'depends) '())) 47 (us (cdr us))) 48 (cond ((null? deps) 49 (loop us done)) 50 ((memq (car deps) done) 51 (loop2 (cdr deps) us)) 52 (else 53 (loop2 (cdr deps) (cons (car deps) us)))))))))))