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