; print cross ref of a function
(defun cross-ref nexpr (fn)
  (xref fn)
  (xref-cleanup fn))
 
 
; find references of this form and return them.
(defun refs (form)
  (prog (fn)
        (cond ((atom form) nil)
              ((get (setq fn (car form)) 'xrefsp) (apply1 (get fn 'xrefsp) (cdr form)))
              ((get fn 'expr) (nconc (list fn) (refs-list (cdr form))))
              ((get fn 'subr) (refs-list (cdr form)))
              (t nil))))
 
 
; get the references of a list of forms
(defun refs-list (forms)
  (mapcan 'refs forms))
 
 
(defun xref (fn)
  (cond ((neq t (get fn 'xref t)) nil)
        (t (put fn 'xref (unionq nil (refs-list (cddr (getfn fn)))))
           (print-xref fn)
           (mapc 'xref (get fn 'xref))
           nil)))
 
 
(defun print-xref (fn)
  (prin1 fn)
  (prin1 'references:)
  (mapc 'prin1 (get fn 'xref))
  (terpri))
 
 
(defun xref-cleanup (fn)
  (prog (refs) (setq refs (get fn 'xref)) (rem fn 'xref) (mapc 'xref-cleanup refs)))
 
 
(defun foo (x)
  (junk x)
  (foo x))
 
 
(defun junk (x)
  (cdr x))
 
 
(defun cond-xref (forms)
  (mapcan 'refs-list forms))
 
 
(defprop cond xrefsp cond-xref)
 
 
(defprop prog xrefsp prog-xref)
 
 
(defun prog-xref (forms)
  (refs-list (cdr forms)))
 
 
(defun foobar (x)
  (foo (junk x)))
 
 
(defun map-xref (args)
  (nconc (xref-fn (car args)) (refs-list (cdr args))))
 
 
(defun xref-fn (fn)
  (cond ((atom fn) nil)
        ((neq 'quote (car fn)) (refs (car fn)))
        ((atom (cadr fn)) (check-fn (cadr fn)))
        (t (refs (cadr fn)))))
 
 
; if fn is an expr return its name else nil
(defun check-fn (fn)
  (cond ((get fn 'expr) (list fn))))
 
 
(defprop (map mapc maplist mapcar mapcon mapcan) xrefsp map-xref)
 
 
(defprop (apply apply1) xrefsp map-xref)
 
 
 ; nov 10, 1976 11:25:23
