From f84c962a616201310e4abf384afaf64f3982a477 Mon Sep 17 00:00:00 2001
From: emarsden <emarsden>
Date: Mon, 24 Feb 2003 16:40:05 +0000
Subject: [PATCH] Delete some unreachable code and debugging statements.

---
 compiler/xref.lisp | 46 ++++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 22 deletions(-)

diff --git a/compiler/xref.lisp b/compiler/xref.lisp
index c874df1ad..d66bf1e35 100644
--- a/compiler/xref.lisp
+++ b/compiler/xref.lisp
@@ -3,7 +3,7 @@
 ;;; Author: Eric Marsden <emarsden@laas.fr>
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/xref.lisp,v 1.1 2003/02/05 19:36:39 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/xref.lisp,v 1.2 2003/02/24 16:40:05 emarsden Exp $")
 ;;
 ;; This code was written as part of the CMUCL project and has been
 ;; placed in the public domain.
@@ -34,7 +34,12 @@
 ;;     FASL file, so you need to recompile all files in the current image
 ;;
 ;;   - maybe add macros EXT:WITH-XREF, and an :xref option to
-;;   COMPILE-FILE, as per ACL.
+;;     COMPILE-FILE, as per ACL.
+;;
+;;   - add WHO-MACROEXPANDS
+;;
+;;   - in (defun foo (x) (flet ((bar (y) (+ x y))) (bar 3))), we want to see
+;;     FOO calling (:internal BAR FOO)
 ;;
 ;; The cross-reference facility is implemented by walking the IR1
 ;; representation that is generated by CMUCL when compiling (for both
@@ -229,22 +234,6 @@ be set at runtime."
     ((not lambda-node)
      (list :anonymous toplevel-name))
 
-    ((not (eq (lambda-home lambda-node) lambda-node))
-     (let ((home (lambda-name (lambda-home lambda-node)))
-           (here (lambda-name lambda-node)))
-       (cond ((and home here)
-              (list :internal home here))
-             (t
-              (or here toplevel-name)))))
-
-    ((lambda-calls lambda-node)
-     (let ((home (lambda-name (lambda-home lambda-node)))
-           (here (lambda-name lambda-node)))
-       (cond ((and home here)
-              (list :internal home here))
-             (t
-              (or here toplevel-name)))))
-
     ;; for DEFMETHOD forms
     ((eql 0 (search "defmethod" toplevel-name :test 'char-equal))
      ;; FIXME this probably won't handle FLET/LABELS inside a
@@ -258,6 +247,21 @@ be set at runtime."
     ;; LET and FLET bindings introduce new unnamed LAMBDA nodes.
     ;; If the home slot contains a lambda with a nice name, we use
     ;; that; otherwise fall back on the toplevel-name.
+    ((or (not (eq (lambda-home lambda-node) lambda-node))
+         (lambda-calls lambda-node))
+     (let ((home (lambda-name (lambda-home lambda-node)))
+           (here (lambda-name lambda-node)))
+       (cond ((and home here)
+              (list :internal home here))
+             ((symbolp here) here)
+             ((symbolp home) home)
+             (t
+              (or here home toplevel-name)))))
+
+    ;; LET and FLET bindings introduce new unnamed LAMBDA nodes.
+    ;; If the home slot contains a lambda with a nice name, we use
+    ;; that; otherwise fall back on the toplevel-name.
+    #+nil
     ((not (lambda-name lambda-node))
      (let ((home (lambda-home lambda-node)))
        (or (and home (lambda-name home))
@@ -331,16 +335,14 @@ be set at runtime."
                     ;; that have no name; they are mostly due to code
                     ;; inserted by the compiler (eg calls to %VERIFY-ARGUMENT-COUNT)
                     ((not caller)
-                     (format t "XREF: ignoring call to ~a in ~a because nil lexical environment~%"
-                             called lambda))
+                     nil)
                     ;; we're not interested in lexical environments
                     ;; named "Top-Level Form".
                     ((and (stringp caller)
                           (string= "Top-Level Form" caller))
                      t)
                     ((not called)
-                     (format t "XREF: ignoring call from ~a in ~a because caller ~a unnamed~%"
-                             caller lambda))
+                     nil)
                     ((eq :global-function (global-var-kind leaf))
                      (xref:register-xref :calls called context))
                     ((eq :special (global-var-kind leaf))
-- 
GitLab