source: trunk/source/lib/xref.lisp @ 12327

Last change on this file since 12327 was 12327, checked in by gz, 10 years ago

Indentation, doc string changes, move *direct-methods-only* from xref to source-files, which is the only place it's used

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 25.5 KB
Line 
1;;; -*- Mode: Lisp; Package: CCL; indent-tabs-mode: nil -*-
2;;;
3;;;   Copyright (C) 2003 Oliver Markovic <entrox@entrox.org>
4;;;   This file is part of OpenMCL.
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence.
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :load-toplevel :execute)
20  (export '(*RECORD-XREF-INFO*
21            *LOAD-XREF-INFO*
22            XREF-ENTRY
23            XREF-ENTRY-NAME
24            XREF-ENTRY-TYPE
25            XREF-ENTRY-METHOD-QUALIFIERS
26            XREF-ENTRY-METHOD-SPECIALIZERS
27            XREF-ENTRY-P
28            XREF-ENTRY-EQUAL
29            DISCARD-ALL-XREF-INFO
30            GET-RELATION
31            MACROS-CALLED-BY
32            START-XREF
33            STOP-XREF
34            WHO-BINDS
35            WHO-CALLS
36            WHO-DIRECTLY-CALLS
37            WHO-INDIRECTLY-CALLS
38            WHO-REFERENCES
39            WHO-SETS
40            WHO-USES
41            WITH-XREF
42            XREF-DESCRIBE)))
43
44(defpackage "CROSS-REFERENCE"
45  (:use "CL")
46  (:nicknames "XREF")
47  (:import-from "CCL"
48                "*RECORD-XREF-INFO*"
49                "*LOAD-XREF-INFO*"
50                "XREF-ENTRY"
51                "XREF-ENTRY-NAME"
52                "XREF-ENTRY-TYPE"
53                "XREF-ENTRY-METHOD-QUALIFIERS"
54                "XREF-ENTRY-METHOD-SPECIALIZERS"
55                "XREF-ENTRY-P"
56                "XREF-ENTRY-EQUAL"
57                "DISCARD-ALL-XREF-INFO"
58                "GET-RELATION"
59                "MACROS-CALLED-BY"
60                "START-XREF"
61                "STOP-XREF"
62                "WHO-BINDS"
63                "WHO-CALLS"
64                "WHO-DIRECTLY-CALLS"
65                "WHO-INDIRECTLY-CALLS"
66                "WHO-REFERENCES"
67                "WHO-SETS"
68                "WHO-USES"
69                "WITH-XREF"
70                "XREF-DESCRIBE")
71  (:export "*RECORD-XREF-INFO*"
72           "*LOAD-XREF-INFO*"
73           "XREF-ENTRY"
74           "XREF-ENTRY-NAME"
75           "XREF-ENTRY-TYPE"
76           "XREF-ENTRY-METHOD-QUALIFIERS"
77           "XREF-ENTRY-METHOD-SPECIALIZERS"
78           "XREF-ENTRY-P"
79           "XREF-ENTRY-EQUAL"
80           "DISCARD-ALL-XREF-INFO"
81           "GET-RELATION"
82           "MACROS-CALLED-BY"
83           "START-XREF"
84           "STOP-XREF"
85           "WHO-BINDS"
86           "WHO-CALLS"
87           "WHO-DIRECTLY-CALLS"
88           "WHO-INDIRECTLY-CALLS"
89           "WHO-REFERENCES"
90           "WHO-SETS"
91           "WHO-USES"
92           "WITH-XREF"
93           "XREF-DESCRIBE"))
94
95
96;; *RECORD-XREF-INFO* -- external
97;;
98;; Cross-referencing information will only be recorded if this flag
99;; is set. It is usually set/unset by START-XREF/STOP-XREF
100(defvar *record-xref-info* nil
101  "Flag indicating wether cross-referencing information should be recorded.")
102
103;; *LOAD-XREF-INFO* -- external
104;;
105;; FIXME: We don't save any information yet...
106(defvar *load-xref-info* nil
107  "Flag indicating wether cross-referencing information should be loaded
108from FASLs.")
109
110
111
112;; START-XREF -- external
113;;
114(defun start-xref ()
115  "Start recording cross-referencing information while compiling."
116  (setf *record-xref-info* t)
117  (setf *load-xref-info* t)
118  t)
119
120;; STOP-XREF -- external
121;;
122(defun stop-xref ()
123  "Stop recording cross-referencing information while compiling."
124  (setf *record-xref-info* nil)
125  (setf *load-xref-info* nil)
126  nil)
127
128;; WITH-XREF -- external
129;;
130(defmacro with-xref (&body body)
131  "Execute BODY with cross-referencing turned on."
132  (let ((return-value (gensym "RETURN-VALUE")))
133    `(let ((*record-xref-info* t)
134           (*load-xref-info* t)
135           (,return-value nil))
136       (setf ,return-value (progn ,@body))
137       ,return-value)))
138
139
140;; XREF-ENTRY -- external
141;;
142(defstruct (xref-entry
143            (:constructor %make-xref-entry)
144            (:print-function %print-xref-entry))
145  name
146  type
147  (method-qualifiers nil)
148  (method-specializers nil))
149
150;; %PRINT-XREF-ENTRY -- internal
151;;
152(defun %print-xref-entry (struct stream d)
153  (declare (ignore d))
154  (if *print-readably*
155      (format stream "#S(xref::xref-entry :name '~A :type '~A :method-qualifiers ~A :method-specializers ~A)"
156              (xref-entry-name struct)
157              (xref-entry-type struct)
158              (xref-entry-method-qualifiers struct)
159              (xref-entry-method-specializers struct))
160    (print-unreadable-object (struct stream :type t)
161      (format stream "~A ~A~@[ ~A~]~@[ ~A~]"
162              (xref-entry-name struct)
163              (xref-entry-type struct)
164              (xref-entry-method-qualifiers struct)
165              (xref-entry-method-specializers struct)))))
166
167;; MAKE-XREF-ENTRY -- internal
168;;
169;; Takes a simple input form and makes a XREF-ENTRY from it. The input is
170;; assumed to be a function, macro or variable when a simple symbol is passed,
171;; or a method when it is a cons. Since this needs to also handle the ouput
172;; from CCL::CALLERS, there is additional hackery trying to do the right thing.
173(defun make-xref-entry (input relation)
174  (etypecase input
175    (symbol
176     (let ((type (ecase relation
177                   ((:direct-calls :indirect-calls) 'function)
178                   ((:binds :sets :references) 'variable)
179                   ((:macro-calls) 'macro))))
180       (%make-xref-entry :name input :type type)))
181    (method
182     (let ((name (method-name input))
183           (qualifiers (method-qualifiers input))
184           (specializers (canonicalize-specializers (method-specializers input))))
185       (%make-xref-entry :name name :type 'method
186                         :method-qualifiers (unless (eql qualifiers t) qualifiers)
187                         :method-specializers specializers)))
188    (cons
189     (case (car input)
190       ((ppc-lap-macro compiler-macro-function)
191        (%make-xref-entry :name (cadr input) :type (car input)))
192       ((:internal)
193        (make-xref-entry (car (last input)) relation))
194       (t
195        (multiple-value-bind (type name specializers qualifiers)
196            (parse-definition-spec input)
197          (%make-xref-entry :name name :type type
198                            :method-qualifiers (unless (eql qualifiers t) qualifiers)
199                            :method-specializers specializers)))))))
200
201(defun parse-definition-spec (form)
202  (let ((type t)
203        name classes qualifiers)
204    (cond
205     ((consp form)
206      (cond ((eq (car form) 'setf)
207             (setq name form))
208            (t (setq name (car form))
209               (let ((last (car (last (cdr form)))))
210                 (cond ((and (listp last)(or (null last)(neq (car last) 'eql)))
211                        (setq classes last)
212                        (setq qualifiers (butlast (cdr form))))
213                       (t (setq classes (cdr form)))))                   
214               (cond ((null qualifiers)
215                      (setq qualifiers t))
216                     ((equal qualifiers '(:primary))
217                      (setq qualifiers nil))))))
218     (t (setq name form)))
219    (when (and (consp name)(eq (car name) 'setf))
220        (setq name (or (%setf-method (cadr name)) name))) ; e.g. rplacd
221    (when (not (or (symbolp name)
222                   (setf-function-name-p name)))
223      (return-from parse-definition-spec))
224    (when (consp qualifiers)
225      (mapc #'(lambda (q)
226                (when (listp q)
227                  (return-from parse-definition-spec)))
228          qualifiers))
229    (when classes
230      (mapc #'(lambda (c)
231                (when (not (and c (or (symbolp c)(and (consp c)(eq (car c) 'eql)))))
232                  (return-from parse-definition-spec)))
233            classes))           
234    (when (or (consp classes)(consp qualifiers))(setq type 'method))
235    (values type name classes qualifiers)))
236
237;; XREF-ENTRY-EQUAL -- external
238;;
239;; Simply compares all slots.
240(defun xref-entry-equal (entry1 entry2)
241  (and (eql (xref-entry-name entry1) (xref-entry-name entry2))
242       (eql (xref-entry-type entry1) (xref-entry-type entry2))
243       (equal (xref-entry-method-qualifiers entry1)
244              (xref-entry-method-qualifiers entry2))
245       (equal (xref-entry-method-specializers entry1)
246              (xref-entry-method-specializers entry2))))
247
248;; %DB-KEY-FROM-XREF-ENTRY -- internal
249;;
250;; This is mostly the inverse to MAKE-XREF-ENTRY, since it takes an entry
251;; and returns either a symbol (for functions, macros and variables) or a
252;; list in the form (METHOD-NAME QUALIFIERS (SPECIALIZERS)) for a method.
253;; These are used as keys in the database hash-tables.
254(defun %db-key-from-xref-entry (entry)
255  (if (eql (xref-entry-type entry) 'method)
256      `(,(xref-entry-name entry)
257        ,@(xref-entry-method-qualifiers entry)
258        ,(xref-entry-method-specializers entry))
259    (xref-entry-name entry)))
260
261;; %SOURCE-FILE-FOR-XREF-ENTRY -- internal
262;;
263(defun %source-file-for-xref-entry (entry)
264  (multiple-value-bind (files name type specializers qualifiers)
265      (edit-definition-p (%db-key-from-xref-entry entry)
266                         (if (eql (xref-entry-type entry) 'macro)
267                             'function
268                           (xref-entry-type entry)))
269    (declare (ignore name type specializers qualifiers))
270    (let ((filename (if (consp files) (cdar files) files)))
271      (when filename
272        (truename filename)))))
273
274
275;; MAKE-XREF-DATABASE -- internal
276;;
277;; This returns a fresh cross-referencing "database". It's a simple association
278;; list with two hash-tables per entry. The CAR hash holds the direct entries
279;; e.g. KEY calls/references/etc VALUE, while the CDR holds inverse hash (KEY
280;; is called/referenced/etc by VALUE.
281(defun make-xref-database ()
282  (list :binds (cons (make-hash-table :test #'equal)
283                     (make-hash-table :test #'equal))
284        :references (cons (make-hash-table :test #'equal)
285                          (make-hash-table :test #'equal))
286        :sets (cons (make-hash-table :test #'equal)
287                    (make-hash-table :test #'equal))
288        :direct-calls (cons (make-hash-table :test #'equal)
289                            (make-hash-table :test #'equal))
290        :indirect-calls (cons (make-hash-table :test #'equal)
291                              (make-hash-table :test #'equal))
292        :macro-calls (cons (make-hash-table :test #'equal)
293                           (make-hash-table :test #'equal))))
294
295;; *XREF-DATABASE* -- internal
296;;
297;; The one and only cross-referencing database.
298(defvar *xref-database* (make-xref-database))
299
300
301;; %XREF-TABLE -- internal
302;;
303;; Returns the appropriate table for a given relation.
304(defun %xref-table (relation inversep)
305  (if inversep
306      (cdr (getf *xref-database* relation))
307    (car (getf *xref-database* relation))))
308
309
310;; DISCARD-ALL-XREF-INFO -- external
311;;
312(defun discard-all-xref-info ()
313  "Clear the cross-referencing database."
314  (setf *xref-database* (make-xref-database))
315  t)
316
317
318;; %ADD-XREF-ENTRY -- internal
319;;
320;; The compiler adds cross-referencing information by calling this
321;; (see NX-RECORD-XREF-INFO).
322(defun %add-xref-entry (relation name1 name2)
323  (when (and *record-xref-info* relation name1 name2)
324    (pushnew (make-xref-entry name2 relation)
325             (gethash name1 (%xref-table relation nil))
326             :test #'xref-entry-equal)
327    (pushnew (make-xref-entry name1 relation)
328             (gethash name2 (%xref-table relation t))
329             :test #'xref-entry-equal)
330    t))
331
332
333
334
335;; %DISCARD-XREF-INFO-FOR-FUNCTION -- internal
336;;
337;; This rather expensive operation removes all traces of a given function
338;; from the cross-referencing database. It needs to be called whenever a
339;; function gets redefined, so we don't pick up stale xref entries.
340(defun %discard-xref-info-for-function (func)
341  ;; need to go through every possible relation
342  (dolist (relation '(:direct-calls :indirect-calls :macro-calls
343                      :binds :references :sets))
344    ;; get a list of the places to which the func points to...
345    (dolist (entry (gethash func (%xref-table relation nil)))
346      (let ((key (%db-key-from-xref-entry entry)))
347        ;; ... and remove it from there
348        (setf (gethash key (%xref-table relation t))
349              (delete func (gethash key (%xref-table relation t))))))
350    ;; the non-inverse case is easy
351    (remhash func (%xref-table relation nil))))
352
353
354;; GET-RELATION -- external
355;;
356;; FIXME: Implement filtering by files.
357;;        And what the heck should errorp do?
358(defun get-relation (relation name1 name2 &key in-files in-functions exhaustive errorp)
359  "Returns a list of matches for RELATION between NAME1 and NAME2. Results can
360be filtered by passing a list of files in IN-FILES or functions in IN-FUNCTIONS.
361If EXHAUSTIVE is true, it will also look for callers for which no xref information
362is present by looping through all defined functions in memory."
363  (when (and (eql name1 :wild) (eql name2 :wild))
364    (error "Only one wildcard allowed in a cross-reference query"))
365  (ecase relation
366    ((:binds :references :sets :direct-calls :indirect-calls :macro-calls)
367     (let ((lookup-table (%xref-table relation nil))
368           (inverse-lookup-table (%xref-table relation t)))
369       (let ((matches (if (eql name1 :wild)
370                          (%do-wild-xref-lookup name2 inverse-lookup-table
371                                                in-files in-functions)
372                        (if (eql name2 :wild)
373                            (%do-wild-xref-lookup name1 lookup-table
374                                                  in-files in-functions)
375                          (%do-simple-xref-lookup name1 name2 lookup-table
376                                                  in-files in-functions)))))
377         ;; search all lfuns if exhaustive is t
378         (when (and exhaustive (eql name1 :wild) (or (eql relation :direct-calls)
379                                                     (eql relation :indirect-calls)))
380           (dolist (caller (callers name2))
381             (pushnew (make-xref-entry caller relation)
382                      matches
383                      :test #'xref-entry-equal)))
384         matches)))
385    (:calls
386     (let ((direct-calls (get-relation :direct-calls name1 name2
387                                       :in-files in-files :in-functions in-functions
388                                       :exhaustive exhaustive :errorp errorp))
389           (indirect-calls (get-relation :indirect-calls name1 name2
390                                         :in-files in-files :in-functions in-functions
391                                         :exhaustive exhaustive :errorp errorp))
392           (macro-calls (get-relation :macro-calls name1 name2
393                                      :in-files in-files :in-functions in-functions
394                                      :exhaustive exhaustive :errorp errorp)))
395       (if (or (eql name1 :wild) (eql name2 :wild))
396           ;; need to weed out possible duplicates here
397           (let ((matches nil))
398             (dolist (c direct-calls) (pushnew c matches))
399             (dolist (c indirect-calls) (pushnew c matches))
400             (dolist (c macro-calls) (pushnew c matches))
401             matches)
402         (when (or direct-calls indirect-calls macro-calls)
403           name2))))
404    (:uses
405     (let ((binds (get-relation :binds name1 name2 :in-files in-files
406                                :in-functions in-functions :errorp errorp
407                                :exhaustive exhaustive))
408           (references (get-relation :binds name1 name2 :in-files in-files
409                                     :in-functions in-functions :errorp errorp
410                                     :exhaustive exhaustive))
411           (sets (get-relation :sets name1 name2 :in-files in-files
412                               :in-functions in-functions :errorp errorp
413                               :exhaustive exhaustive)))
414       (if (or (eql name1 :wild) (eql name2 :wild))
415           (concatenate 'list binds references sets)
416         (when (or binds references sets)
417           name2))))))
418
419;; %DO-WILD-XREF-LOOKUP -- internal
420;;
421;; Does a wild lookup into the xref database and returns a list of matches.
422;;
423;; FIXME: implement filtering by files
424(defun %do-wild-xref-lookup (name table in-files in-functions)
425  (declare (ignore in-files))
426  (multiple-value-bind (value foundp) (gethash name table)
427    (declare (ignore foundp))
428    (if in-functions
429        (remove-if (lambda (x) (not (find x in-functions))) value)
430      value)))
431
432;; %DO-SIMPLE-XREF-LOOKUP -- internal
433;;
434;; Does a simple lookup into the xref database and returns NAME2 if a relation
435;; between NAME1 and NAME2 exists.
436;;
437;; FIXME: implement filtering by files
438(defun %do-simple-xref-lookup (name1 name2 table in-files in-functions)
439  (declare (ignore in-files))
440  (when (some (lambda (x)
441                (when in-functions
442                  (find x in-functions))
443                (eql x name2))
444              (gethash name1 table))
445    name2))
446
447
448(defun %print-xref-entries (entries stream verbose)
449  (dolist (entry entries)
450    (if (eql (xref-entry-type entry) 'method)
451        ;; print qualifiers and specializers if it's a method
452        (format stream "~5,5T~A ~@[~A ~]~A~%"
453                (xref-entry-name entry)
454                (xref-entry-method-qualifiers entry)
455                (xref-entry-method-specializers entry))
456      (format stream "~5,5T~A~%" (xref-entry-name entry)))
457    ;; print extra information when verbose
458    (when verbose
459      (format stream "~5,5T  Type: ~A~%" (xref-entry-type entry))
460      (let ((file (%source-file-for-xref-entry entry)))
461        (format stream "~5,5T  File: ~A~%~%" (if file file "not recorded"))))))
462
463
464;; WHO-DIRECTLY-CALLS -- external
465;;
466(defun who-directly-calls (name &key inverse in-files in-functions verbose
467                                (stream *standard-output*))
468  "Prints information about direct callers of NAME. If INVERSE is true,
469it will print direct callees of NAME instead."
470  (let ((callers/callees (if inverse
471                             (get-relation :direct-calls name :wild 
472                                           :in-files in-files
473                                           :in-functions in-functions)
474                           (get-relation :direct-calls :wild name
475                                         :in-files in-files
476                                         :in-functions in-functions
477                                         :exhaustive t))))
478    (format stream "~%~T")
479    (if callers/callees
480        (progn
481          (format stream "~A ~:[is directly called by~;directly calls~]:~%"
482                  name inverse)
483          (%print-xref-entries callers/callees stream verbose))
484      (format stream "No direct ~:[callers~;callees~] of ~A were found in the database~%"
485              inverse name)))
486  (values))
487
488;; WHO-INDIRECTLY-CALLS -- external
489;;
490;; FIXME: Implement this (we can't currently detect indirect calls).
491(defun who-indirectly-calls (name &key inverse in-files in-functions verbose
492                                  (stream *standard-output*))
493  "Prints information about indirect callers of NAME. If INVERSE is true,
494it will print indirect callees of NAME instead."
495  (let ((callers/callees (if inverse
496                             (get-relation :indirect-calls name :wild 
497                                           :in-files in-files
498                                           :in-functions in-functions)
499                           (get-relation :indirect-calls :wild name
500                                         :in-files in-files
501                                         :in-functions in-functions))))
502    (format stream "~%~T")
503    (if callers/callees
504        (progn
505          (format stream "~A ~:[is indirectly called by~;indirectly calls~]:~%"
506                  name inverse)
507          (%print-xref-entries callers/callees stream verbose))
508      (format stream "No indirect ~:[callers~;callees~] of ~A were found in the database~%"
509              inverse name)))
510  (values))
511
512;; MACROS-CALLED-BY -- external
513;;
514(defun macros-called-by (name &key inverse in-files in-functions verbose
515                              (stream *standard-output*))
516  "Prints information about macros which get called by NAME. If INVERSE is true,
517it will list all functions which macroexpand NAME instead."
518    (let ((callers/callees (if (not inverse)
519                             (get-relation :macro-calls name :wild 
520                                           :in-files in-files
521                                           :in-functions in-functions)
522                           (get-relation :macro-calls :wild name
523                                         :in-files in-files
524                                         :in-functions in-functions))))
525    (format stream "~%~T")
526    (if callers/callees
527        (progn
528          (format stream "~A ~:[is macro called by~;macro calls~]:~%"
529                name (not inverse))
530          (%print-xref-entries callers/callees stream verbose))
531      (format stream "No macro ~:[callers~;callees~] of ~A were found in the database~%"
532              (not inverse) name)))
533    (values))
534
535;; WHO-CALLS -- external
536;;
537(defun who-calls (name &key inverse in-files in-functions verbose
538                       (stream *standard-output*))
539  "Shorthand for WHO-DIRECTLY-CALLS, WHO-INDIRECTLY-CALLS and
540MACROS-CALLED-BY."
541  (who-directly-calls name :inverse inverse :stream stream :verbose verbose
542                           :in-files in-files :in-functions in-functions)
543  (who-indirectly-calls name :inverse inverse :stream stream :verbose verbose
544                             :in-files in-files :in-functions in-functions)
545  (macros-called-by name :inverse (not inverse) :stream stream :verbose verbose
546                         :in-files in-files :in-functions in-functions)
547  (values))
548
549
550;; WHO-BINDS -- external
551;;
552(defun who-binds (name &key inverse in-files in-functions verbose
553                       (stream *standard-output*))
554  "Prints a list of functions which bind NAME. If INVERSE is true, it will
555print a list of variables bound by NAME instead."
556  (let ((bindings (if inverse
557                      (get-relation :binds name :wild :in-files in-files
558                                    :in-functions in-functions)
559                    (get-relation :binds :wild name :in-files in-files
560                                  :in-functions in-functions))))
561    (format stream "~%~T")
562    (if bindings
563        (progn
564          (format stream "~A ~:[is bound by~;binds~]:" name inverse)
565          (%print-xref-entries bindings stream verbose))
566      (format stream "No ~:[bindings of~;symbols bound by~] ~A were found in the database~%"
567              inverse name)))
568  (values))
569
570;; WHO-REFERENCES -- external
571;;
572(defun who-references (name &key inverse in-files in-functions verbose
573                            (stream *standard-output*))
574  "Prints a list of functions which reference NAME. If INVERSE is true, it will
575print a list of variables referenced by NAME instead."
576  (let ((references (if inverse
577                        (get-relation :references name :wild :in-files in-files
578                                      :in-functions in-functions)
579                      (get-relation :references :wild name :in-files in-files
580                                    :in-functions in-functions))))
581    (format stream "~%~T")
582    (if references
583        (progn
584          (format stream "~A ~:[is referenced by~;references~]:~%" name inverse)
585          (%print-xref-entries references stream verbose))
586      (format stream "No ~:[references to~;symbols referenced by~] ~A were found in the database~%"
587              inverse name)))
588  (values))
589
590;; WHO-SETS -- external
591;;
592(defun who-sets (name &key inverse in-files in-functions verbose
593                      (stream *standard-output*))
594    "Prints a list of functions which set NAME. If INVERSE is true, it will
595print a list of variables set by NAME instead."
596  (let ((sets (if inverse
597                  (get-relation :sets name :wild :in-files in-files
598                                :in-functions in-functions)
599                (get-relation :sets :wild name :in-files in-files
600                              :in-functions in-functions))))
601    (format stream "~%~T")
602    (if sets
603        (progn
604          (format stream "~A ~:[is set by~;sets~]:~%" name inverse)
605          (%print-xref-entries sets stream verbose))
606      (format stream "No ~:[settings of~;symbols set by~] ~A were found in the database~%"
607              inverse name)))
608  (values))
609
610;; WHO-USES -- external
611;;
612(defun who-uses (name &key inverse in-files in-functions verbose
613                      (stream *standard-output*))
614  "Shorthand for WHO-BINDS, WHO-REFERENCES and WHO-SETS."
615  (who-binds name :inverse inverse :stream stream :verbose verbose
616                  :in-files in-files :in-functions in-functions)
617
618  (who-references name :inverse inverse :stream stream :verbose verbose
619                       :in-files in-files :in-functions in-functions)
620
621  (who-sets name :inverse inverse :stream stream :verbose verbose
622                 :in-files in-files :in-functions in-functions)
623  (values))
624
625
626;; XREF-DESCRIBE -- external
627;;
628(defun xref-describe (name &key verbose)
629  "Prints relevant cross-referencing information about NAME."
630  (if (fboundp name)
631      (progn
632        (who-calls name :stream *terminal-io* :verbose verbose)
633        (who-calls name :inverse t :stream *terminal-io* :verbose verbose)
634        (who-uses name :inverse t :stream *terminal-io* :verbose verbose))
635      (who-uses name :stream *terminal-io* :verbose verbose))
636  (values))
637
638
639;;; Hook into the OpenMCL compiler frontend, by pointing a couple
640;;; of its variables at our functions.
641(setq ccl::*nx-discard-xref-info-hook* #'%discard-xref-info-for-function)
642(setq ccl::*nx-add-xref-entry-hook* #'%add-xref-entry)
643
644(provide :xref)
Note: See TracBrowser for help on using the repository browser.