(herald undef)

;;;;;; Utility for printing undefined names

;;; Load this into T-IMPLEMENTATION-ENV.  Use only for compiled files.
;;; (There is no way, as far as I can tell, to reliably use it for
;;; interpreted files.)

(define (show-undefined foo . env)
  (cond ((unit? foo) (show-unit-undefined foo))
        ((get-unit foo (if (null? env) (repl-env) (car env)))
         => show-unit-undefined)
        (else
         (format t ";No undefined variable information for ~S.~%"
                 foo))))

(*define standard-env 'show-undefined show-undefined)

(define (get-unit filespec env)
  ((lambda (file)
     (and file (unit? file) file))
   (let* ((filename (->filename filespec))
          (objname (filename-with-type filename
                                         (object-file-type
                                          (local-machine))))
          (truename (file-probe objname))
          (namestring (filename->string truename)))
     (loaded-file env namestring))))

(define (show-unit-undefined unit)
  (format t ";Undefined in ~A:~%" unit)
  (let ((len (unit-length unit)))
    (do ((i 0 (fx+ i 1)))
        ((fx= i len))
      (let ((elt (extend-elt unit i)))
        (cond ((vcell? elt)
               (if (nonvalue? (vcell-contents elt))
                   (format t ";  ~A~%" (vcell-id elt))))
              ((link-snapper? elt)
               (let ((v (link-snapper-value elt)))
                 (if (not (procedure? v))
                     (format t ";  ~A (called)~%" v))))))))
  (no-value))

(define-integrable (link-snapper? obj)
  (and (closure? obj)
       (eq? (extend-header obj) *link-snapper-template*)))

(define-integrable (link-snapper-value snapper) (extend-elt snapper 0))
(define-integrable (link-snapper-unit  snapper) (extend-elt snapper 1))
(define-integrable (link-snapper-offset snapper)
  (extend-elt snapper 2))