/[slime]/slime/xref.lisp
ViewVC logotype

Contents of /slime/xref.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Mon May 17 00:25:24 2004 UTC (9 years, 11 months ago) by lgorrie
Branch: MAIN
CVS Tags: SLIME-1-0-ALPHA, SLIME-0-14, SLIME-1-0-BETA, SLIME-2-3, SLIME-2-2, SLIME-2-1, SLIME-2-0, SLIME-1-0, SLIME-1-1, SLIME-1-2, SLIME-1-3, byte-stream, MULTIBYTE-ENCODING, SLIME-1-2-1, FAIRLY-STABLE
Branch point for: contrib, fsm
Changes since 1.1: +2 -2 lines
Renamed XREF package to PXREF (P for portable). This makes it possible
to load the package in e.g. CMUCL, which is nice because it's a good
package.
1 ;;; -*- Mode: LISP; Package: XREF; Syntax: Common-lisp; -*-
2 ;;; Mon Jan 21 16:21:20 1991 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
3 ;;; xref.lisp
4
5 ;;; ****************************************************************
6 ;;; List Callers: A Static Analysis Cross Referencing Tool for Lisp
7 ;;; ****************************************************************
8 ;;;
9 ;;; The List Callers system is a portable Common Lisp cross referencing
10 ;;; utility. It grovels over a set of files and compiles a database of the
11 ;;; locations of all references for each symbol used in the files.
12 ;;; List Callers is similar to the Symbolics Who-Calls and the
13 ;;; Xerox Masterscope facilities.
14 ;;;
15 ;;; When you change a function or variable definition, it can be useful
16 ;;; to know its callers, in order to update each of them to the new
17 ;;; definition. Similarly, having a graphic display of the structure
18 ;;; (e.g., call graph) of a program can help make undocumented code more
19 ;;; understandable. This static code analyzer facilitates both capabilities.
20 ;;; The database compiled by xref is suitable for viewing by a graphical
21 ;;; browser. (Note: the reference graph is not necessarily a DAG. Since many
22 ;;; graphical browsers assume a DAG, this will lead to infinite loops.
23 ;;; Some code which is useful in working around this problem is included,
24 ;;; as well as a sample text-indenting outliner and an interface to Bates'
25 ;;; PSGraph Postscript Graphing facility.)
26 ;;;
27 ;;; Written by Mark Kantrowitz, July 1990.
28 ;;;
29 ;;; Address: School of Computer Science
30 ;;; Carnegie Mellon University
31 ;;; Pittsburgh, PA 15213
32 ;;;
33 ;;; Copyright (c) 1990. All rights reserved.
34 ;;;
35 ;;; See general license below.
36 ;;;
37
38 ;;; ****************************************************************
39 ;;; General License Agreement and Lack of Warranty *****************
40 ;;; ****************************************************************
41 ;;;
42 ;;; This software is distributed in the hope that it will be useful (both
43 ;;; in and of itself and as an example of lisp programming), but WITHOUT
44 ;;; ANY WARRANTY. The author(s) do not accept responsibility to anyone for
45 ;;; the consequences of using it or for whether it serves any particular
46 ;;; purpose or works at all. No warranty is made about the software or its
47 ;;; performance.
48 ;;;
49 ;;; Use and copying of this software and the preparation of derivative
50 ;;; works based on this software are permitted, so long as the following
51 ;;; conditions are met:
52 ;;; o The copyright notice and this entire notice are included intact
53 ;;; and prominently carried on all copies and supporting documentation.
54 ;;; o No fees or compensation are charged for use, copies, or
55 ;;; access to this software. You may charge a nominal
56 ;;; distribution fee for the physical act of transferring a
57 ;;; copy, but you may not charge for the program itself.
58 ;;; o If you modify this software, you must cause the modified
59 ;;; file(s) to carry prominent notices (a Change Log)
60 ;;; describing the changes, who made the changes, and the date
61 ;;; of those changes.
62 ;;; o Any work distributed or published that in whole or in part
63 ;;; contains or is a derivative of this software or any part
64 ;;; thereof is subject to the terms of this agreement. The
65 ;;; aggregation of another unrelated program with this software
66 ;;; or its derivative on a volume of storage or distribution
67 ;;; medium does not bring the other program under the scope
68 ;;; of these terms.
69 ;;; o Permission is granted to manufacturers and distributors of
70 ;;; lisp compilers and interpreters to include this software
71 ;;; with their distribution.
72 ;;;
73 ;;; This software is made available AS IS, and is distributed without
74 ;;; warranty of any kind, either expressed or implied.
75 ;;;
76 ;;; In no event will the author(s) or their institutions be liable to you
77 ;;; for damages, including lost profits, lost monies, or other special,
78 ;;; incidental or consequential damages arising out of or in connection
79 ;;; with the use or inability to use (including but not limited to loss of
80 ;;; data or data being rendered inaccurate or losses sustained by third
81 ;;; parties or a failure of the program to operate as documented) the
82 ;;; program, even if you have been advised of the possibility of such
83 ;;; damanges, or for any claim by any other party, whether in an action of
84 ;;; contract, negligence, or other tortious action.
85 ;;;
86 ;;; The current version of this software and a variety of related utilities
87 ;;; may be obtained by anonymous ftp from ftp.cs.cmu.edu in the directory
88 ;;; user/ai/lang/lisp/code/tools/xref/
89 ;;;
90 ;;; Please send bug reports, comments, questions and suggestions to
91 ;;; mkant@cs.cmu.edu. We would also appreciate receiving any changes
92 ;;; or improvements you may make.
93 ;;;
94 ;;; If you wish to be added to the Lisp-Utilities@cs.cmu.edu mailing list,
95 ;;; send email to Lisp-Utilities-Request@cs.cmu.edu with your name, email
96 ;;; address, and affiliation. This mailing list is primarily for
97 ;;; notification about major updates, bug fixes, and additions to the lisp
98 ;;; utilities collection. The mailing list is intended to have low traffic.
99 ;;;
100
101 ;;; ********************************
102 ;;; Change Log *********************
103 ;;; ********************************
104 ;;;
105 ;;; 27-FEB-91 mk Added insert arg to psgraph-xref to allow the postscript
106 ;;; graphs to be inserted in Scribe documents.
107 ;;; 21-FEB-91 mk Added warning if not compiled.
108 ;;; 07-FEB-91 mk Fixed bug in record-callers with regard to forms at
109 ;;; toplevel.
110 ;;; 21-JAN-91 mk Added file xref-test.lisp to test xref.
111 ;;; 16-JAN-91 mk Added definition WHO-CALLS to parallel the Symbolics syntax.
112 ;;; 16-JAN-91 mk Added macroexpansion capability to record-callers. Also
113 ;;; added parameter *handle-macro-forms*, defaulting to T.
114 ;;; 16-JAN-91 mk Modified print-caller-tree and related functions
115 ;;; to allow the user to specify root nodes. If the user
116 ;;; doesn't specify them, it will default to all root
117 ;;; nodes, as before.
118 ;;; 16-JAN-91 mk Added parameter *default-graphing-mode* to specify
119 ;;; the direction of the graphing. Either :call-graph,
120 ;;; where the children of a node are those functions called
121 ;;; by the node, or :caller-graph where the children of a
122 ;;; node are the callers of the node. :call-graph is the
123 ;;; default.
124 ;;; 16-JAN-91 mk Added parameter *indent-amount* to control the indentation
125 ;;; in print-indented-tree.
126 ;;; 16-JUL-90 mk Functions with argument lists of () were being ignored
127 ;;; because of a (when form) wrapped around the body of
128 ;;; record-callers. Then intent of (when form) was as an extra
129 ;;; safeguard against infinite looping. This wasn't really
130 ;;; necessary, so it has been removed.
131 ;;; 16-JUL-90 mk PSGraph-XREF now has keyword arguments, instead of
132 ;;; optionals.
133 ;;; 16-JUL-90 mk Added PRINT-CLASS-HIERARCHY to use psgraph to graph the
134 ;;; CLOS class hierarchy. This really doesn't belong here,
135 ;;; and should be moved to psgraph.lisp as an example of how
136 ;;; to use psgraph.
137 ;;; 16-JUL-90 mk Fixed several caller patterns. The pattern for member
138 ;;; had an error which caused many references to be missed.
139 ;;; 16-JUL-90 mk Added ability to save/load processed databases.
140 ;;; 5-JUL-91 mk Fixed warning of needing compilation to occur only when the
141 ;;; source is loaded.
142 ;;; 20-SEP-93 mk Added fix from Peter Norvig to allow Xref to xref itself.
143 ;;; The arg to macro-function must be a symbol.
144
145 ;;; ********************************
146 ;;; To Do **************************
147 ;;; ********************************
148 ;;;
149 ;;; Verify that:
150 ;;; o null forms don't cause it to infinite loop.
151 ;;; o nil matches against null argument lists.
152 ;;; o declarations and doc are being ignored.
153 ;;;
154 ;;; Would be nice if in addition to showing callers of a function, it
155 ;;; displayed the context of the calls to the function (e.g., the
156 ;;; immediately surrounding form). This entails storing entries of
157 ;;; the form (symbol context*) in the database and augmenting
158 ;;; record-callers to keep the context around. The only drawbacks is
159 ;;; that it would cons a fair bit. If we do this, we should store
160 ;;; additional information as well in the database, such as the caller
161 ;;; pattern type (e.g., variable vs. function).
162 ;;;
163 ;;; Write a translator from BNF (at least as much of BNF as is used
164 ;;; in CLtL2), to the format used here.
165 ;;;
166 ;;; Should automatically add new patterns for new functions and macros
167 ;;; based on their arglists. Probably requires much more than this
168 ;;; simple code walker, so there isn't much we can do.
169 ;;;
170 ;;; Defmacro is a problem, because it often hides internal function
171 ;;; calls within backquote and quote, which we normally ignore. If
172 ;;; we redefine QUOTE's pattern so that it treats the arg like a FORM,
173 ;;; we'll probably get them (though maybe the syntax will be mangled),
174 ;;; but most likely a lot of spurious things as well.
175 ;;;
176 ;;; Define an operation for Defsystem which will run XREF-FILE on the
177 ;;; files of the system. Or yet simpler, when XREF sees a LOAD form
178 ;;; for which the argument is a string, tries to recursively call
179 ;;; XREF-FILE on the specified file. Then one could just XREF-FILE
180 ;;; the file which loads the system. (This should be a program
181 ;;; parameter.)
182 ;;;
183 ;;; Have special keywords which the user may place in a file to have
184 ;;; XREF-FILE ignore a region.
185 ;;;
186 ;;; Should we distinguish flet and labels from defun? I.e., note that
187 ;;; flet's definitions are locally defined, instead of just lumping
188 ;;; them in with regular definitions.
189 ;;;
190 ;;; Add patterns for series, loop macro.
191 ;;;
192 ;;; Need to integrate the variable reference database with the other
193 ;;; databases, yet maintain separation. So we can distinguish all
194 ;;; the different types of variable and function references, without
195 ;;; multiplying databases.
196 ;;;
197 ;;; Would pay to comment record-callers and record-callers* in more
198 ;;; depth.
199 ;;;
200 ;;; (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
201
202 ;;; ********************************
203 ;;; Notes **************************
204 ;;; ********************************
205 ;;;
206 ;;; XREF has been tested (successfully) in the following lisps:
207 ;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
208 ;;; Macintosh Allegro Common Lisp (1.3.2)
209 ;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
210 ;;; Lucid CL (Version 2.1 6-DEC-87)
211 ;;;
212 ;;; XREF has been tested (unsuccessfully) in the following lisps:
213 ;;; Ibuki Common Lisp (01/01, October 15, 1987)
214 ;;; - if interpreted, runs into stack overflow
215 ;;; - does not compile (tried ibcl on Suns, PMAXes and RTs)
216 ;;; seems to be due to a limitation in the c compiler.
217 ;;;
218 ;;; XREF needs to be tested in the following lisps:
219 ;;; Symbolics Common Lisp (8.0)
220 ;;; Lucid Common Lisp (3.0, 4.0)
221 ;;; KCL (June 3, 1987 or later)
222 ;;; AKCL (1.86, June 30, 1987 or later)
223 ;;; TI (Release 4.1 or later)
224 ;;; Golden Common Lisp (3.1 IBM-PC)
225 ;;; VAXLisp (2.0, 3.1)
226 ;;; HP Common Lisp (same as Lucid?)
227 ;;; Procyon Common Lisp
228
229
230 ;;; ****************************************************************
231 ;;; Documentation **************************************************
232 ;;; ****************************************************************
233 ;;;
234 ;;; XREF analyzes a user's program, determining which functions call a
235 ;;; given function, and the location of where variables are bound/assigned
236 ;;; and used. The user may retrieve this information for either a single
237 ;;; symbol, or display the call graph of portions of the program
238 ;;; (including the entire program). This allows the programmer to debug
239 ;;; and document the program's structure.
240 ;;;
241 ;;; XREF is primarily intended for analyzing large programs, where it is
242 ;;; difficult, if not impossible, for the programmer to grasp the structure
243 ;;; of the whole program. Nothing precludes using XREF for smaller programs,
244 ;;; where it can be useful for inspecting the relationships between pieces
245 ;;; of the program and for documenting the program.
246 ;;;
247 ;;; Two aspects of the Lisp programming language greatly simplify the
248 ;;; analysis of Lisp programs:
249 ;;; o Lisp programs are naturally represented as data.
250 ;;; Successive definitions from a file are easily read in
251 ;;; as list structure.
252 ;;; o The basic syntax of Lisp is uniform. A list program
253 ;;; consists of a set of nested forms, where each form is
254 ;;; a list whose car is a tag (e.g., function name) that
255 ;;; specifies the structure of the rest of the form.
256 ;;; Thus Lisp programs, when represented as data, can be considered to be
257 ;;; parse trees. Given a grammar of syntax patterns for the language, XREF
258 ;;; recursively descends the parse tree for a given definition, computing
259 ;;; a set of relations that hold for the definition at each node in the
260 ;;; tree. For example, one kind of relation is that the function defined
261 ;;; by the definition calls the functions in its body. The relations are
262 ;;; stored in a database for later examination by the user.
263 ;;;
264 ;;; While XREF currently only works for programs written in Lisp, it could
265 ;;; be extended to other programming languages by writing a function to
266 ;;; generate parse trees for definitions in that language, and a core
267 ;;; set of patterns for the language's syntax.
268 ;;;
269 ;;; Since XREF normally does a static syntactic analysis of the program,
270 ;;; it does not detect references due to the expansion of a macro definition.
271 ;;; To do this in full generality XREF would have to have knowledge about the
272 ;;; semantics of the program (e.g., macros which call other functions to
273 ;;; do the expansion). This entails either modifying the compiler to
274 ;;; record the relationships (e.g., Symbolics Who-Calls Database) or doing
275 ;;; a walk of loaded code and macroexpanding as needed (PCL code walker).
276 ;;; The former is not portable, while the latter requires that the code
277 ;;; used by macros be loaded and in working order. On the other hand, then
278 ;;; we would need no special knowledge about macros (excluding the 24 special
279 ;;; forms of Lisp).
280 ;;;
281 ;;; Parameters may be set to enable macro expansion in XREF. Then XREF
282 ;;; will expand any macros for which it does not have predefined patterns.
283 ;;; (For example, most Lisps will implement dolist as a macro. Since XREF
284 ;;; has a pattern defined for dolist, it will not call macroexpand-1 on
285 ;;; a form whose car is dolist.) For this to work properly, the code must
286 ;;; be loaded before being processed by XREF, and XREF's parameters should
287 ;;; be set so that it processes forms in their proper packages.
288 ;;;
289 ;;; If macro expansion is disabled, the default rules for handling macro
290 ;;; references may not be sufficient for some user-defined macros, because
291 ;;; macros allow a variety of non-standard syntactic extensions to the
292 ;;; language. In this case, the user may specify additional templates in
293 ;;; a manner similar to that in which the core Lisp grammar was specified.
294 ;;;
295
296
297 ;;; ********************************
298 ;;; User Guide *********************
299 ;;; ********************************
300 ;;; -----
301 ;;; The following functions are called to cross reference the source files.
302 ;;;
303 ;;; XREF-FILES (&rest files) [FUNCTION]
304 ;;; Grovels over the lisp code located in source file FILES, using
305 ;;; xref-file.
306 ;;;
307 ;;; XREF-FILE (filename &optional clear-tables verbose) [Function]
308 ;;; Cross references the function and variable calls in FILENAME by
309 ;;; walking over the source code located in the file. Defaults type of
310 ;;; filename to ".lisp". Chomps on the code using record-callers and
311 ;;; record-callers*. If CLEAR-TABLES is T (the default), it clears the
312 ;;; callers database before processing the file. Specify CLEAR-TABLES as
313 ;;; nil to append to the database. If VERBOSE is T (the default), prints
314 ;;; out the name of the file, one progress dot for each form processed,
315 ;;; and the total number of forms.
316 ;;;
317 ;;; -----
318 ;;; The following functions display information about the uses of the
319 ;;; specified symbol as a function, variable, or constant.
320 ;;;
321 ;;; LIST-CALLERS (symbol) [FUNCTION]
322 ;;; Lists all functions which call SYMBOL as a function (function
323 ;;; invocation).
324 ;;;
325 ;;; LIST-READERS (symbol) [FUNCTION]
326 ;;; Lists all functions which refer to SYMBOL as a variable
327 ;;; (variable reference).
328 ;;;
329 ;;; LIST-SETTERS (symbol) [FUNCTION]
330 ;;; Lists all functions which bind/set SYMBOL as a variable
331 ;;; (variable mutation).
332 ;;;
333 ;;; LIST-USERS (symbol) [FUNCTION]
334 ;;; Lists all functions which use SYMBOL as a variable or function.
335 ;;;
336 ;;; WHO-CALLS (symbol &optional how) [FUNCTION]
337 ;;; Lists callers of symbol. HOW may be :function, :reader, :setter,
338 ;;; or :variable."
339 ;;;
340 ;;; WHAT-FILES-CALL (symbol) [FUNCTION]
341 ;;; Lists names of files that contain uses of SYMBOL
342 ;;; as a function, variable, or constant.
343 ;;;
344 ;;; SOURCE-FILE (symbol) [FUNCTION]
345 ;;; Lists the names of files in which SYMBOL is defined/used.
346 ;;;
347 ;;; LIST-CALLEES (symbol) [FUNCTION]
348 ;;; Lists names of functions and variables called by SYMBOL.
349 ;;;
350 ;;; -----
351 ;;; The following functions may be useful for viewing the database and
352 ;;; debugging the calling patterns.
353 ;;;
354 ;;; *LAST-FORM* () [VARIABLE]
355 ;;; The last form read from the file. Useful for figuring out what went
356 ;;; wrong when xref-file drops into the debugger.
357 ;;;
358 ;;; *XREF-VERBOSE* t [VARIABLE]
359 ;;; When T, xref-file(s) prints out the names of the files it looks at,
360 ;;; progress dots, and the number of forms read.
361 ;;;
362 ;;; *TYPES-TO-IGNORE* (quote (:lisp :lisp2)) [VARIABLE]
363 ;;; Default set of caller types (as specified in the patterns) to ignore
364 ;;; in the database handling functions. :lisp is CLtL 1st edition,
365 ;;; :lisp2 is additional patterns from CLtL 2nd edition.
366 ;;;
367 ;;; *HANDLE-PACKAGE-FORMS* () [VARIABLE]
368 ;;; When non-NIL, and XREF-FILE sees a package-setting form like
369 ;;; IN-PACKAGE, sets the current package to the specified package by
370 ;;; evaluating the form. When done with the file, xref-file resets the
371 ;;; package to its original value. In some of the displaying functions,
372 ;;; when this variable is non-NIL one may specify that all symbols from a
373 ;;; particular set of packages be ignored. This is only useful if the
374 ;;; files use different packages with conflicting names.
375 ;;;
376 ;;; *HANDLE-FUNCTION-FORMS* t [VARIABLE]
377 ;;; When T, XREF-FILE tries to be smart about forms which occur in
378 ;;; a function position, such as lambdas and arbitrary Lisp forms.
379 ;;; If so, it recursively calls record-callers with pattern 'FORM.
380 ;;; If the form is a lambda, makes the caller a caller of
381 ;;; :unnamed-lambda.
382 ;;;
383 ;;; *HANDLE-MACRO-FORMS* t [VARIABLE]
384 ;;; When T, if the file was loaded before being processed by XREF, and
385 ;;; the car of a form is a macro, it notes that the parent calls the
386 ;;; macro, and then calls macroexpand-1 on the form.
387 ;;;
388 ;;; *DEFAULT-GRAPHING-MODE* :call-graph [VARIABLE]
389 ;;; Specifies whether we graph up or down. If :call-graph, the children
390 ;;; of a node are the functions it calls. If :caller-graph, the
391 ;;; children of a node are the functions that call it.
392 ;;;
393 ;;; *INDENT-AMOUNT* 3 [VARIABLE]
394 ;;; Number of spaces to indent successive levels in PRINT-INDENTED-TREE.
395 ;;;
396 ;;; DISPLAY-DATABASE (&optional database types-to-ignore) [FUNCTION]
397 ;;; Prints out the name of each symbol and all its callers. Specify
398 ;;; database :callers (the default) to get function call references,
399 ;;; :file to the get files in which the symbol is called, :readers to get
400 ;;; variable references, and :setters to get variable binding and
401 ;;; assignments. Ignores functions of types listed in types-to-ignore.
402 ;;;
403 ;;; PRINT-CALLER-TREES (&key (mode *default-graphing-mode*) [FUNCTION]
404 ;;; (types-to-ignore *types-to-ignore*)
405 ;;; compact root-nodes)
406 ;;; Prints the calling trees (which may actually be a full graph and not
407 ;;; necessarily a DAG) as indented text trees using
408 ;;; PRINT-INDENTED-TREE. MODE is :call-graph for trees where the children
409 ;;; of a node are the functions called by the node, or :caller-graph for
410 ;;; trees where the children of a node are the functions the node calls.
411 ;;; TYPES-TO-IGNORE is a list of funcall types (as specified in the
412 ;;; patterns) to ignore in printing out the database. For example,
413 ;;; '(:lisp) would ignore all calls to common lisp functions. COMPACT is
414 ;;; a flag to tell the program to try to compact the trees a bit by not
415 ;;; printing trees if they have already been seen. ROOT-NODES is a list
416 ;;; of root nodes of trees to display. If ROOT-NODES is nil, tries to
417 ;;; find all root nodes in the database.
418 ;;;
419 ;;; MAKE-CALLER-TREE (&optional (mode *default-graphing-mode*) [FUNCTION]
420 ;;; (types-to-ignore *types-to-ignore*)
421 ;;; compact)
422 ;;; Outputs list structure of a tree which roughly represents the
423 ;;; possibly cyclical structure of the caller database.
424 ;;; If mode is :call-graph, the children of a node are the functions
425 ;;; it calls. If mode is :caller-graph, the children of a node are the
426 ;;; functions that call it.
427 ;;; If compact is T, tries to eliminate the already-seen nodes, so
428 ;;; that the graph for a node is printed at most once. Otherwise it will
429 ;;; duplicate the node's tree (except for cycles). This is usefull
430 ;;; because the call tree is actually a directed graph, so we can either
431 ;;; duplicate references or display only the first one.
432 ;;;
433 ;;; DETERMINE-FILE-DEPENDENCIES (&optional database) [FUNCTION]
434 ;;; Makes a hash table of file dependencies for the references listed in
435 ;;; DATABASE. This function may be useful for automatically resolving
436 ;;; file references for automatic creation of a system definition
437 ;;; (defsystem).
438 ;;;
439 ;;; PRINT-FILE-DEPENDENCIES (&optional database) [FUNCTION]
440 ;;; Prints a list of file dependencies for the references listed in
441 ;;; DATABASE. This function may be useful for automatically computing
442 ;;; file loading constraints for a system definition tool.
443 ;;;
444 ;;; WRITE-CALLERS-DATABASE-TO-FILE (filename) [FUNCTION]
445 ;;; Saves the contents of the current callers database to a file. This
446 ;;; file can be loaded to restore the previous contents of the
447 ;;; database. (For large systems it can take a long time to crunch
448 ;;; through the code, so this can save some time.)
449 ;;;
450 ;;; -----
451 ;;; The following macros define new function and macro call patterns.
452 ;;; They may be used to extend the static analysis tool to handle
453 ;;; new def forms, extensions to Common Lisp, and program defs.
454 ;;;
455 ;;; DEFINE-PATTERN-SUBSTITUTION (name pattern) [MACRO]
456 ;;; Defines NAME to be equivalent to the specified pattern. Useful for
457 ;;; making patterns more readable. For example, the LAMBDA-LIST is
458 ;;; defined as a pattern substitution, making the definition of the
459 ;;; DEFUN caller-pattern simpler.
460 ;;;
461 ;;; DEFINE-CALLER-PATTERN (name pattern &optional caller-type) [MACRO]
462 ;;; Defines NAME as a function/macro call with argument structure
463 ;;; described by PATTERN. CALLER-TYPE, if specified, assigns a type to
464 ;;; the pattern, which may be used to exclude references to NAME while
465 ;;; viewing the database. For example, all the Common Lisp definitions
466 ;;; have a caller-type of :lisp or :lisp2, so that you can exclude
467 ;;; references to common lisp functions from the calling tree.
468 ;;;
469 ;;; DEFINE-VARIABLE-PATTERN (name &optional caller-type) [MACRO]
470 ;;; Defines NAME as a variable reference of type CALLER-TYPE. This is
471 ;;; mainly used to establish the caller-type of the variable.
472 ;;;
473 ;;; DEFINE-CALLER-PATTERN-SYNONYMS (source destinations) [MACRO]
474 ;;; For defining function caller pattern syntax synonyms. For each name
475 ;;; in DESTINATIONS, defines its pattern as a copy of the definition
476 ;;; of SOURCE. Allows a large number of identical patterns to be defined
477 ;;; simultaneously. Must occur after the SOURCE has been defined.
478 ;;;
479 ;;; -----
480 ;;; This system includes pattern definitions for the latest
481 ;;; common lisp specification, as published in Guy Steele,
482 ;;; Common Lisp: The Language, 2nd Edition.
483 ;;;
484 ;;; Patterns may be either structures to match, or a predicate
485 ;;; like symbolp/numberp/stringp. The pattern specification language
486 ;;; is similar to the notation used in CLtL2, but in a more lisp-like
487 ;;; form:
488 ;;; (:eq name) The form element must be eq to the symbol NAME.
489 ;;; (:test test) TEST must be true when applied to the form element.
490 ;;; (:typep type) The form element must be of type TYPE.
491 ;;; (:or pat1 pat2 ...) Tries each of the patterns in left-to-right order,
492 ;;; until one succeeds.
493 ;;; Equivalent to { pat1 | pat2 | ... }
494 ;;; (:rest pattern) The remaining form elements are grouped into a
495 ;;; list which is matched against PATTERN.
496 ;;; (:optional pat1 ...) The patterns may optionally match against the
497 ;;; form element.
498 ;;; Equivalent to [ pat1 ... ].
499 ;;; (:star pat1 ...) The patterns may match against the patterns
500 ;;; any number of times, including 0.
501 ;;; Equivalent to { pat1 ... }*.
502 ;;; (:plus pat1 ...) The patterns may match against the patterns
503 ;;; any number of times, but at least once.
504 ;;; Equivalent to { pat1 ... }+.
505 ;;; &optional, &key, Similar in behavior to the corresponding
506 ;;; &rest lambda-list keywords.
507 ;;; FORM A random lisp form. If a cons, assumes the
508 ;;; car is a function or macro and tries to
509 ;;; match the args against that symbol's pattern.
510 ;;; If a symbol, assumes it's a variable reference.
511 ;;; :ignore Ignores the corresponding form element.
512 ;;; NAME The corresponding form element should be
513 ;;; the name of a new definition (e.g., the
514 ;;; first arg in a defun pattern is NAME.
515 ;;; FUNCTION, MACRO The corresponding form element should be
516 ;;; a function reference not handled by FORM.
517 ;;; Used in the definition of apply and funcall.
518 ;;; VAR The corresponding form element should be
519 ;;; a variable definition or mutation. Used
520 ;;; in the definition of let, let*, etc.
521 ;;; VARIABLE The corresponding form element should be
522 ;;; a variable reference.
523 ;;;
524 ;;; In all other pattern symbols, it looks up the symbols pattern substitution
525 ;;; and recursively matches against the pattern. Automatically destructures
526 ;;; list structure that does not include consing dots.
527 ;;;
528 ;;; Among the pattern substitution names defined are:
529 ;;; STRING, SYMBOL, NUMBER Appropriate :test patterns.
530 ;;; LAMBDA-LIST Matches against a lambda list.
531 ;;; BODY Matches against a function body definition.
532 ;;; FN Matches against #'function, 'function,
533 ;;; and lambdas. This is used in the definition
534 ;;; of apply, funcall, and the mapping patterns.
535 ;;; and others...
536 ;;;
537 ;;; Here's some sample pattern definitions:
538 ;;; (define-caller-pattern defun
539 ;;; (name lambda-list
540 ;;; (:star (:or documentation-string declaration))
541 ;;; (:star form))
542 ;;; :lisp)
543 ;;; (define-caller-pattern funcall (fn (:star form)) :lisp)
544 ;;;
545 ;;; In general, the system is intelligent enough to handle any sort of
546 ;;; simple funcall. One only need specify the syntax for functions and
547 ;;; macros which use optional arguments, keyword arguments, or some
548 ;;; argument positions are special, such as in apply and funcall, or
549 ;;; to indicate that the function is of the specified caller type.
550 ;;;
551 ;;;
552 ;;; NOTES:
553 ;;;
554 ;;; XRef assumes syntactically correct lisp code.
555 ;;;
556 ;;; This is by no means perfect. For example, let and let* are treated
557 ;;; identically, instead of differentiating between serial and parallel
558 ;;; binding. But it's still a useful tool. It can be helpful in
559 ;;; maintaining code, debugging problems with patch files, determining
560 ;;; whether functions are multiply defined, and help you remember where
561 ;;; a function is defined or called.
562 ;;;
563 ;;; XREF runs best when compiled.
564
565 ;;; ********************************
566 ;;; References *********************
567 ;;; ********************************
568 ;;;
569 ;;; Xerox Interlisp Masterscope Program:
570 ;;; Larry M Masinter, Global program analysis in an interactive environment
571 ;;; PhD Thesis, Stanford University, 1980.
572 ;;;
573 ;;; Symbolics Who-Calls Database:
574 ;;; User's Guide to Symbolics Computers, Volume 1, Cambridge, MA, July 1986
575 ;;; Genera 7.0, pp 183-185.
576 ;;;
577
578 ;;; ********************************
579 ;;; Example ************************
580 ;;; ********************************
581 ;;;
582 ;;; Here is an example of running XREF on a short program.
583 ;;; [In Scribe documentation, give a simple short program and resulting
584 ;;; XREF output, including postscript call graphs.]
585 #|
586 <cl> (xref:xref-file "/afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp")
587 Cross-referencing file /afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp.
588 ................................................
589 48 forms processed.
590 <cl> (xref:display-database :readers)
591
592 *DISPLAY-CUTOFF-DEPTH* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
593 *OFFSET-FROM-EDGE-OF-PANE* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
594 *WITHIN-LEVEL-SPACING* is referenced by BREADTH CALCULATE-POSITION-INFO.
595 *DIRECTION* is referenced by CREATE-POSITION-INFO.
596 *LINK-OFFSET* is referenced by OFFSET-OF-LINK-FROM-ATTACHMENT-POINT.
597 *ROOT-IS-SEQUENCE* is referenced by GRAPH.
598 *LEVEL-SPACING* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
599 *ORIENTATION* is referenced by BREADTH CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
600 *DEFAULT-GRAPH-POSITION* is referenced by CREATE-POSITION-INFO.
601 *GRAPHING-CUTOFF-DEPTH* is referenced by CREATE-NODE-STRUCTURE.
602 *LIST-OF-NODES* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CREATE-NODE FIND-NODE.
603 *GRAPH-TYPE* is referenced by CREATE-NODE-STRUCTURE.
604 <cl> (xref:print-caller-trees :root-nodes '(display-graph))
605
606 Rooted calling trees:
607 DISPLAY-GRAPH
608 CREATE-POSITION-INFO
609 CALCULATE-POSITION-INFO
610 CALCULATE-POSITION
611 NODE-POSITION-ALREADY-SET-FLAG
612 NODE-LEVEL-ALREADY-SET-FLAG
613 CALCULATE-POSITION-IN-LEVEL
614 NODE-CHILDREN
615 NODE-LEVEL
616 CALCULATE-POSITION
617 NEW-CALCULATE-BREADTH
618 NODE-CHILDREN
619 BREADTH
620 OPPOSITE-DIMENSION
621 NODE-HEIGHT
622 NODE-WIDTH
623 NEW-CALCULATE-BREADTH
624 NODE-PARENTS
625 OPPOSITE-DIMENSION
626 NODE-HEIGHT
627 NODE-WIDTH
628 OPPOSITE-POSITION
629 NODE-Y
630 NODE-X
631 NODE-LEVEL
632 CALCULATE-LEVEL-POSITION
633 NODE-LEVEL
634 NODE-POSITION
635 NODE-X
636 NODE-Y
637 DIMENSION
638 NODE-WIDTH
639 NODE-HEIGHT
640 CALCULATE-LEVEL-POSITION-BEFORE
641 NODE-LEVEL
642 NODE-POSITION
643 NODE-X
644 NODE-Y
645 NODE-WIDTH
646 NODE-HEIGHT
647 DIMENSION
648 NODE-WIDTH
649 NODE-HEIGHT
650 |#
651
652 ;;; ****************************************************************
653 ;;; List Callers ***************************************************
654 ;;; ****************************************************************
655
656 (defpackage :pxref
657 (:use :common-lisp)
658 (:export #:list-callers
659 #:list-users
660 #:list-readers
661 #:list-setters
662 #:what-files-call
663 #:who-calls
664 #:list-callees
665 #:source-file
666 #:clear-tables
667 #:define-pattern-substitution
668 #:define-caller-pattern
669 #:define-variable-pattern
670 #:define-caller-pattern-synonyms
671 #:clear-patterns
672 #:*last-form*
673 #:*xref-verbose*
674 #:*handle-package-forms*
675 #:*handle-function-forms*
676 #:*handle-macro-forms*
677 #:*types-to-ignore*
678 #:*last-caller-tree*
679 #:*default-graphing-mode*
680 #:*indent-amount*
681 #:xref-file
682 #:xref-files
683 #:write-callers-database-to-file
684 #:display-database
685 #:print-caller-trees
686 #:make-caller-tree
687 #:print-indented-tree
688 #:determine-file-dependencies
689 #:print-file-dependencies
690 #:psgraph-xref
691 ))
692
693 (in-package "PXREF")
694
695 ;;; Warn user if they're loading the source instead of compiling it first.
696 ;(eval-when (compile load eval)
697 ; (defvar compiled-p nil))
698 ;(eval-when (compile load)
699 ; (setq compiled-p t))
700 ;(eval-when (load eval)
701 ; (unless compiled-p
702 ; (warn "This file should be compiled before loading for best results.")))
703 (eval-when (eval)
704 (warn "This file should be compiled before loading for best results."))
705
706
707 ;;; ********************************
708 ;;; Primitives *********************
709 ;;; ********************************
710 (defun lookup (symbol environment)
711 (dolist (frame environment)
712 (when (member symbol frame)
713 (return symbol))))
714
715 (defun car-eq (list item)
716 (and (consp list)
717 (eq (car list) item)))
718
719 ;;; ********************************
720 ;;; Callers Database ***************
721 ;;; ********************************
722 (defvar *file-callers-database* (make-hash-table :test #'equal)
723 "Contains name and list of file callers (files which call) for that name.")
724 (defvar *callers-database* (make-hash-table :test #'equal)
725 "Contains name and list of callers (function invocation) for that name.")
726 (defvar *readers-database* (make-hash-table :test #'equal)
727 "Contains name and list of readers (variable use) for that name.")
728 (defvar *setters-database* (make-hash-table :test #'equal)
729 "Contains name and list of setters (variable mutation) for that name.")
730 (defvar *callees-database* (make-hash-table :test #'equal)
731 "Contains name and list of functions and variables it calls.")
732 (defun callers-list (name &optional (database :callers))
733 (case database
734 (:file (gethash name *file-callers-database*))
735 (:callees (gethash name *callees-database*))
736 (:callers (gethash name *callers-database*))
737 (:readers (gethash name *readers-database*))
738 (:setters (gethash name *setters-database*))))
739 (defsetf callers-list (name &optional (database :callers)) (caller)
740 `(setf (gethash ,name (case ,database
741 (:file *file-callers-database*)
742 (:callees *callees-database*)
743 (:callers *callers-database*)
744 (:readers *readers-database*)
745 (:setters *setters-database*)))
746 ,caller))
747
748 (defun list-callers (symbol)
749 "Lists all functions which call SYMBOL as a function (function invocation)."
750 (callers-list symbol :callers))
751 (defun list-readers (symbol)
752 "Lists all functions which refer to SYMBOL as a variable
753 (variable reference)."
754 (callers-list symbol :readers))
755 (defun list-setters (symbol)
756 "Lists all functions which bind/set SYMBOL as a variable
757 (variable mutation)."
758 (callers-list symbol :setters))
759 (defun list-users (symbol)
760 "Lists all functions which use SYMBOL as a variable or function."
761 (values (list-callers symbol)
762 (list-readers symbol)
763 (list-setters symbol)))
764 (defun who-calls (symbol &optional how)
765 "Lists callers of symbol. HOW may be :function, :reader, :setter,
766 or :variable."
767 ;; would be nice to have :macro and distinguish variable
768 ;; binding from assignment. (i.e., variable binding, assignment, and use)
769 (case how
770 (:function (list-callers symbol))
771 (:reader (list-readers symbol))
772 (:setter (list-setters symbol))
773 (:variable (append (list-readers symbol)
774 (list-setters symbol)))
775 (otherwise (append (list-callers symbol)
776 (list-readers symbol)
777 (list-setters symbol)))))
778 (defun what-files-call (symbol)
779 "Lists names of files that contain uses of SYMBOL
780 as a function, variable, or constant."
781 (callers-list symbol :file))
782 (defun list-callees (symbol)
783 "Lists names of functions and variables called by SYMBOL."
784 (callers-list symbol :callees))
785
786 (defvar *source-file* (make-hash-table :test #'equal)
787 "Contains function name and source file for that name.")
788 (defun source-file (symbol)
789 "Lists the names of files in which SYMBOL is defined/used."
790 (gethash symbol *source-file*))
791 (defsetf source-file (name) (value)
792 `(setf (gethash ,name *source-file*) ,value))
793
794 (defun clear-tables ()
795 (clrhash *file-callers-database*)
796 (clrhash *callers-database*)
797 (clrhash *callees-database*)
798 (clrhash *readers-database*)
799 (clrhash *setters-database*)
800 (clrhash *source-file*))
801
802
803 ;;; ********************************
804 ;;; Pattern Database ***************
805 ;;; ********************************
806 ;;; Pattern Types
807 (defvar *pattern-caller-type* (make-hash-table :test #'equal))
808 (defun pattern-caller-type (name)
809 (gethash name *pattern-caller-type*))
810 (defsetf pattern-caller-type (name) (value)
811 `(setf (gethash ,name *pattern-caller-type*) ,value))
812
813 ;;; Pattern Substitutions
814 (defvar *pattern-substitution-table* (make-hash-table :test #'equal)
815 "Stores general patterns for function destructuring.")
816 (defun lookup-pattern-substitution (name)
817 (gethash name *pattern-substitution-table*))
818 (defmacro define-pattern-substitution (name pattern)
819 "Defines NAME to be equivalent to the specified pattern. Useful for
820 making patterns more readable. For example, the LAMBDA-LIST is
821 defined as a pattern substitution, making the definition of the
822 DEFUN caller-pattern simpler."
823 `(setf (gethash ',name *pattern-substitution-table*)
824 ',pattern))
825
826 ;;; Function/Macro caller patterns:
827 ;;; The car of the form is skipped, so we don't need to specify
828 ;;; (:eq function-name) like we would for a substitution.
829 ;;;
830 ;;; Patterns must be defined in the XREF package because the pattern
831 ;;; language is tested by comparing symbols (using #'equal) and not
832 ;;; their printreps. This is fine for the lisp grammer, because the XREF
833 ;;; package depends on the LISP package, so a symbol like 'xref::cons is
834 ;;; translated automatically into 'lisp::cons. However, since
835 ;;; (equal 'foo::bar 'baz::bar) returns nil unless both 'foo::bar and
836 ;;; 'baz::bar are inherited from the same package (e.g., LISP),
837 ;;; if package handling is turned on the user must specify package
838 ;;; names in the caller pattern definitions for functions that occur
839 ;;; in packages other than LISP, otherwise the symbols will not match.
840 ;;;
841 ;;; Perhaps we should enforce the definition of caller patterns in the
842 ;;; XREF package by wrapping the body of define-caller-pattern in
843 ;;; the XREF package:
844 ;;; (defmacro define-caller-pattern (name value &optional caller-type)
845 ;;; (let ((old-package *package*))
846 ;;; (setf *package* (find-package "XREF"))
847 ;;; (prog1
848 ;;; `(progn
849 ;;; (when ',caller-type
850 ;;; (setf (pattern-caller-type ',name) ',caller-type))
851 ;;; (when ',value
852 ;;; (setf (gethash ',name *caller-pattern-table*)
853 ;;; ',value)))
854 ;;; (setf *package* old-package))))
855 ;;; Either that, or for the purpose of pattern testing we should compare
856 ;;; printreps. [The latter makes the primitive patterns like VAR
857 ;;; reserved words.]
858 (defvar *caller-pattern-table* (make-hash-table :test #'equal)
859 "Stores patterns for function destructuring.")
860 (defun lookup-caller-pattern (name)
861 (gethash name *caller-pattern-table*))
862 (defmacro define-caller-pattern (name pattern &optional caller-type)
863 "Defines NAME as a function/macro call with argument structure
864 described by PATTERN. CALLER-TYPE, if specified, assigns a type to
865 the pattern, which may be used to exclude references to NAME while
866 viewing the database. For example, all the Common Lisp definitions
867 have a caller-type of :lisp or :lisp2, so that you can exclude
868 references to common lisp functions from the calling tree."
869 `(progn
870 (when ',caller-type
871 (setf (pattern-caller-type ',name) ',caller-type))
872 (when ',pattern
873 (setf (gethash ',name *caller-pattern-table*)
874 ',pattern))))
875
876 ;;; For defining variables
877 (defmacro define-variable-pattern (name &optional caller-type)
878 "Defines NAME as a variable reference of type CALLER-TYPE. This is
879 mainly used to establish the caller-type of the variable."
880 `(progn
881 (when ',caller-type
882 (setf (pattern-caller-type ',name) ',caller-type))))
883
884 ;;; For defining synonyms. Means much less space taken up by the patterns.
885 (defmacro define-caller-pattern-synonyms (source destinations)
886 "For defining function caller pattern syntax synonyms. For each name
887 in DESTINATIONS, defines its pattern as a copy of the definition of SOURCE.
888 Allows a large number of identical patterns to be defined simultaneously.
889 Must occur after the SOURCE has been defined."
890 `(let ((source-type (pattern-caller-type ',source))
891 (source-pattern (gethash ',source *caller-pattern-table*)))
892 (when source-type
893 (dolist (dest ',destinations)
894 (setf (pattern-caller-type dest) source-type)))
895 (when source-pattern
896 (dolist (dest ',destinations)
897 (setf (gethash dest *caller-pattern-table*)
898 source-pattern)))))
899
900 (defun clear-patterns ()
901 (clrhash *pattern-substitution-table*)
902 (clrhash *caller-pattern-table*)
903 (clrhash *pattern-caller-type*))
904
905 ;;; ********************************
906 ;;; Cross Reference Files **********
907 ;;; ********************************
908 (defvar *last-form* ()
909 "The last form read from the file. Useful for figuring out what went wrong
910 when xref-file drops into the debugger.")
911
912 (defvar *xref-verbose* t
913 "When T, xref-file(s) prints out the names of the files it looks at,
914 progress dots, and the number of forms read.")
915
916 ;;; This needs to first clear the tables?
917 (defun xref-files (&rest files)
918 "Grovels over the lisp code located in source file FILES, using xref-file."
919 ;; If the arg is a list, use it.
920 (when (listp (car files)) (setq files (car files)))
921 (dolist (file files)
922 (xref-file file nil))
923 (values))
924
925 (defvar *handle-package-forms* nil ;'(lisp::in-package)
926 "When non-NIL, and XREF-FILE sees a package-setting form like IN-PACKAGE,
927 sets the current package to the specified package by evaluating the
928 form. When done with the file, xref-file resets the package to its
929 original value. In some of the displaying functions, when this variable
930 is non-NIL one may specify that all symbols from a particular set of
931 packages be ignored. This is only useful if the files use different
932 packages with conflicting names.")
933
934 (defvar *normal-readtable* (copy-readtable nil)
935 "Normal, unadulterated CL readtable.")
936
937 (defun xref-file (filename &optional (clear-tables t) (verbose *xref-verbose*))
938 "Cross references the function and variable calls in FILENAME by
939 walking over the source code located in the file. Defaults type of
940 filename to \".lisp\". Chomps on the code using record-callers and
941 record-callers*. If CLEAR-TABLES is T (the default), it clears the callers
942 database before processing the file. Specify CLEAR-TABLES as nil to
943 append to the database. If VERBOSE is T (the default), prints out the
944 name of the file, one progress dot for each form processed, and the
945 total number of forms."
946 ;; Default type to "lisp"
947 (when (and (null (pathname-type filename))
948 (not (probe-file filename)))
949 (cond ((stringp filename)
950 (setf filename (concatenate 'string filename ".lisp")))
951 ((pathnamep filename)
952 (setf filename (merge-pathnames filename
953 (make-pathname :type "lisp"))))))
954 (when clear-tables (clear-tables))
955 (let ((count 0)
956 (old-package *package*)
957 (*readtable* *normal-readtable*))
958 (when verbose
959 (format t "~&Cross-referencing file ~A.~&" filename))
960 (with-open-file (stream filename :direction :input)
961 (do ((form (read stream nil :eof) (read stream nil :eof)))
962 ((eq form :eof))
963 (incf count)
964 (when verbose
965 (format *standard-output* ".")
966 (force-output *standard-output*))
967 (setq *last-form* form)
968 (record-callers filename form)
969 ;; Package Magic.
970 (when (and *handle-package-forms*
971 (consp form)
972 (member (car form) *handle-package-forms*))
973 (eval form))))
974 (when verbose
975 (format t "~&~D forms processed." count))
976 (setq *package* old-package)
977 (values)))
978
979 (defvar *handle-function-forms* t
980 "When T, XREF-FILE tries to be smart about forms which occur in
981 a function position, such as lambdas and arbitrary Lisp forms.
982 If so, it recursively calls record-callers with pattern 'FORM.
983 If the form is a lambda, makes the caller a caller of :unnamed-lambda.")
984
985 (defvar *handle-macro-forms* t
986 "When T, if the file was loaded before being processed by XREF, and the
987 car of a form is a macro, it notes that the parent calls the macro,
988 and then calls macroexpand-1 on the form.")
989
990 (defvar *callees-database-includes-variables* nil)
991
992 (defun record-callers (filename form
993 &optional pattern parent (environment nil)
994 funcall)
995 "RECORD-CALLERS is the main routine used to walk down the code. It matches
996 the PATTERN against the FORM, possibly adding statements to the database.
997 PARENT is the name defined by the current outermost definition; it is
998 the caller of the forms in the body (e.g., FORM). ENVIRONMENT is used
999 to keep track of the scoping of variables. FUNCALL deals with the type
1000 of variable assignment and hence how the environment should be modified.
1001 RECORD-CALLERS handles atomic patterns and simple list-structure patterns.
1002 For complex list-structure pattern destructuring, it calls RECORD-CALLERS*."
1003 ; (when form)
1004 (unless pattern (setq pattern 'FORM))
1005 (cond ((symbolp pattern)
1006 (case pattern
1007 (:IGNORE
1008 ;; Ignores the rest of the form.
1009 (values t parent environment))
1010 (NAME
1011 ;; This is the name of a new definition.
1012 (push filename (source-file form))
1013 (values t form environment))
1014 ((FUNCTION MACRO)
1015 ;; This is the name of a call.
1016 (cond ((and *handle-function-forms* (consp form))
1017 ;; If we're a cons and special handling is on,
1018 (when (eq (car form) 'lambda)
1019 (pushnew filename (callers-list :unnamed-lambda :file))
1020 (when parent
1021 (pushnew parent (callers-list :unnamed-lambda
1022 :callers))
1023 (pushnew :unnamed-lambda (callers-list parent
1024 :callees))))
1025 (record-callers filename form 'form parent environment))
1026 (t
1027 ;; If we're just a regular function name call.
1028 (pushnew filename (callers-list form :file))
1029 (when parent
1030 (pushnew parent (callers-list form :callers))
1031 (pushnew form (callers-list parent :callees)))
1032 (values t parent environment))))
1033 (VAR
1034 ;; This is the name of a new variable definition.
1035 ;; Includes arglist parameters.
1036 (when (and (symbolp form) (not (keywordp form))
1037 (not (member form lambda-list-keywords)))
1038 (pushnew form (car environment))
1039 (pushnew filename (callers-list form :file))
1040 (when parent
1041 ; (pushnew form (callers-list parent :callees))
1042 (pushnew parent (callers-list form :setters)))
1043 (values t parent environment)))
1044 (VARIABLE
1045 ;; VAR reference
1046 (pushnew filename (callers-list form :file))
1047 (when (and parent (not (lookup form environment)))
1048 (pushnew parent (callers-list form :readers))
1049 (when *callees-database-includes-variables*
1050 (pushnew form (callers-list parent :callees))))
1051 (values t parent environment))
1052 (FORM
1053 ;; A random form (var or funcall).
1054 (cond ((consp form)
1055 ;; Get new pattern from TAG.
1056 (let ((new-pattern (lookup-caller-pattern (car form))))
1057 (pushnew filename (callers-list (car form) :file))
1058 (when parent
1059 (pushnew parent (callers-list (car form) :callers))
1060 (pushnew (car form) (callers-list parent :callees)))
1061 (cond ((and new-pattern (cdr form))
1062 ;; Special Pattern and there's stuff left
1063 ;; to be processed. Note that we check if
1064 ;; a pattern is defined for the form before
1065 ;; we check to see if we can macroexpand it.
1066 (record-callers filename (cdr form) new-pattern
1067 parent environment :funcall))
1068 ((and *handle-macro-forms*
1069 (symbolp (car form)) ; pnorvig 9/9/93
1070 (macro-function (car form)))
1071 ;; The car of the form is a macro and
1072 ;; macro processing is turned on. Macroexpand-1
1073 ;; the form and try again.
1074 (record-callers filename
1075 (macroexpand-1 form)
1076 'form parent environment
1077 :funcall))
1078 ((null (cdr form))
1079 ;; No more left to be processed. Note that
1080 ;; this must occur after the macros clause,
1081 ;; since macros can expand into more code.
1082 (values t parent environment))
1083 (t
1084 ;; Random Form. We assume it is a function call.
1085 (record-callers filename (cdr form)
1086 '((:star FORM))
1087 parent environment :funcall)))))
1088 (t
1089 (when (and (not (lookup form environment))
1090 (not (numberp form))
1091 ;; the following line should probably be
1092 ;; commented out?
1093 (not (keywordp form))
1094 (not (stringp form))
1095 (not (eq form t))
1096 (not (eq form nil)))
1097 (pushnew filename (callers-list form :file))
1098 ;; ??? :callers
1099 (when parent
1100 (pushnew parent (callers-list form :readers))
1101 (when *callees-database-includes-variables*
1102 (pushnew form (callers-list parent :callees)))))
1103 (values t parent environment))))
1104 (otherwise
1105 ;; Pattern Substitution
1106 (let ((new-pattern (lookup-pattern-substitution pattern)))
1107 (if new-pattern
1108 (record-callers filename form new-pattern
1109 parent environment)
1110 (when (eq pattern form)
1111 (values t parent environment)))))))
1112 ((consp pattern)
1113 (case (car pattern)
1114 (:eq (when (eq (second pattern) form)
1115 (values t parent environment)))
1116 (:test (when (funcall (eval (second pattern)) form)
1117 (values t parent environment)))
1118 (:typep (when (typep form (second pattern))
1119 (values t parent environment)))
1120 (:or (dolist (subpat (rest pattern))
1121 (multiple-value-bind (processed parent environment)
1122 (record-callers filename form subpat
1123 parent environment)
1124 (when processed
1125 (return (values processed parent environment))))))
1126 (:rest ; (:star :plus :optional :rest)
1127 (record-callers filename form (second pattern)
1128 parent environment))
1129 (otherwise
1130 (multiple-value-bind (d p env)
1131 (record-callers* filename form pattern
1132 parent (cons nil environment))
1133 (values d p (if funcall environment env))))))))
1134
1135 (defun record-callers* (filename form pattern parent environment
1136 &optional continuation
1137 in-optionals in-keywords)
1138 "RECORD-CALLERS* handles complex list-structure patterns, such as
1139 ordered lists of subpatterns, patterns involving :star, :plus,
1140 &optional, &key, &rest, and so on. CONTINUATION is a stack of
1141 unprocessed patterns, IN-OPTIONALS and IN-KEYWORDS are corresponding
1142 stacks which determine whether &rest or &key has been seen yet in
1143 the current pattern."
1144 ;; form must be a cons or nil.
1145 ; (when form)
1146 (if (null pattern)
1147 (if (null continuation)
1148 (values t parent environment)
1149 (record-callers* filename form (car continuation) parent environment
1150 (cdr continuation)
1151 (cdr in-optionals)
1152 (cdr in-keywords)))
1153 (let ((pattern-elt (car pattern)))
1154 (cond ((car-eq pattern-elt :optional)
1155 (if (null form)
1156 (values t parent environment)
1157 (multiple-value-bind (processed par env)
1158 (record-callers* filename form (cdr pattern-elt)
1159 parent environment
1160 (cons (cdr pattern) continuation)
1161 (cons (car in-optionals) in-optionals)
1162 (cons (car in-keywords) in-keywords))
1163 (if processed
1164 (values processed par env)
1165 (record-callers* filename form (cdr pattern)
1166 parent environment continuation
1167 in-optionals in-keywords)))))
1168 ((car-eq pattern-elt :star)
1169 (if (null form)
1170 (values t parent environment)
1171 (multiple-value-bind (processed par env)
1172 (record-callers* filename form (cdr pattern-elt)
1173 parent environment
1174 (cons pattern continuation)
1175 (cons (car in-optionals) in-optionals)
1176 (cons (car in-keywords) in-keywords))
1177 (if processed
1178 (values processed par env)
1179 (record-callers* filename form (cdr pattern)
1180 parent environment continuation
1181 in-optionals in-keywords)))))
1182 ((car-eq pattern-elt :plus)
1183 (record-callers* filename form (cdr pattern-elt)
1184 parent environment
1185 (cons (cons (cons :star (cdr pattern-elt))
1186 (cdr pattern))
1187 continuation)
1188 (cons (car in-optionals) in-optionals)
1189 (cons (car in-keywords) in-keywords)))
1190 ((car-eq pattern-elt :rest)
1191 (record-callers filename form pattern-elt parent environment))
1192 ((eq pattern-elt '&optional)
1193 (record-callers* filename form (cdr pattern)
1194 parent environment continuation
1195 (cons t in-optionals)
1196 (cons (car in-keywords) in-keywords)))
1197 ((eq pattern-elt '&rest)
1198 (record-callers filename form (second pattern)
1199 parent environment))
1200 ((eq pattern-elt '&key)
1201 (record-callers* filename form (cdr pattern)
1202 parent environment continuation
1203 (cons (car in-optionals) in-optionals)
1204 (cons t in-keywords)))
1205 ((null form)
1206 (when (or (car in-keywords) (car in-optionals))
1207 (values t parent environment)))
1208 ((consp form)
1209 (multiple-value-bind (processed parent environment)
1210 (record-callers filename (if (car in-keywords)
1211 (cadr form)
1212 (car form))
1213 pattern-elt
1214 parent environment)
1215 (cond (processed
1216 (record-callers* filename (if (car in-keywords)
1217 (cddr form)
1218 (cdr form))
1219 (cdr pattern)
1220 parent environment
1221 continuation
1222 in-optionals in-keywords))
1223 ((or (car in-keywords)
1224 (car in-optionals))
1225 (values t parent environment)))))))))
1226
1227
1228 ;;; ********************************
1229 ;;; Misc Utilities *****************
1230 ;;; ********************************
1231 (defvar *types-to-ignore*
1232 '(:lisp ; CLtL 1st Edition
1233 :lisp2 ; CLtL 2nd Edition additional patterns
1234 )
1235 "Default set of caller types (as specified in the patterns) to ignore
1236 in the database handling functions. :lisp is CLtL 1st edition,
1237 :lisp2 is additional patterns from CLtL 2nd edition.")
1238
1239 (defun display-database (&optional (database :callers)
1240 (types-to-ignore *types-to-ignore*))
1241 "Prints out the name of each symbol and all its callers. Specify database
1242 :callers (the default) to get function call references, :fill to the get
1243 files in which the symbol is called, :readers to get variable references,
1244 and :setters to get variable binding and assignments. Ignores functions
1245 of types listed in types-to-ignore."
1246 (maphash #'(lambda (name callers)
1247 (unless (or (member (pattern-caller-type name)
1248 types-to-ignore)
1249 ;; When we're doing fancy package crap,
1250 ;; allow us to ignore symbols based on their
1251 ;; packages.
1252 (when *handle-package-forms*
1253 (member (symbol-package name)
1254 types-to-ignore
1255 :key #'find-package)))
1256 (format t "~&~S is referenced by~{ ~S~}."
1257 name callers)))
1258 (ecase database
1259 (:file *file-callers-database*)
1260 (:callers *callers-database*)
1261 (:readers *readers-database*)
1262 (:setters *setters-database*))))
1263
1264 (defun write-callers-database-to-file (filename)
1265 "Saves the contents of the current callers database to a file. This
1266 file can be loaded to restore the previous contents of the
1267 database. (For large systems it can take a long time to crunch
1268 through the code, so this can save some time.)"
1269 (with-open-file (stream filename :direction :output)
1270 (format stream "~&(clear-tables)")
1271 (maphash #'(lambda (x y)
1272 (format stream "~&(setf (source-file '~S) '~S)"
1273 x y))
1274 *source-file*)
1275 (maphash #'(lambda (x y)
1276 (format stream "~&(setf (callers-list '~S :file) '~S)"
1277 x y))
1278 *file-callers-database*)
1279 (maphash #'(lambda (x y)
1280 (format stream "~&(setf (callers-list '~S :callers) '~S)"
1281 x y))
1282 *callers-database*)
1283 (maphash #'(lambda (x y)
1284 (format stream "~&(setf (callers-list '~S :callees) '~S)"
1285 x y))
1286 *callees-database*)
1287 (maphash #'(lambda (x y)
1288 (format stream "~&(setf (callers-list '~S :readers) '~S)"
1289 x y))
1290 *readers-database*)
1291 (maphash #'(lambda (x y)
1292 (format stream "~&(setf (callers-list '~S :setters) '~S)"
1293 x y))
1294 *setters-database*)))
1295
1296
1297 ;;; ********************************
1298 ;;; Print Caller Trees *************
1299 ;;; ********************************
1300 ;;; The following function is useful for reversing a caller table into
1301 ;;; a callee table. Possibly later we'll extend xref to create two
1302 ;;; such database hash tables. Needs to include vars as well.
1303 (defun invert-hash-table (table &optional (types-to-ignore *types-to-ignore*))
1304 "Makes a copy of the hash table in which (name value*) pairs
1305 are inverted to (value name*) pairs."
1306 (let ((target (make-hash-table :test #'equal)))
1307 (maphash #'(lambda (key values)
1308 (dolist (value values)
1309 (unless (member (pattern-caller-type key)
1310 types-to-ignore)
1311 (pushnew key (gethash value target)))))
1312 table)
1313 target))
1314
1315 ;;; Resolve file references for automatic creation of a defsystem file.
1316 (defun determine-file-dependencies (&optional (database *callers-database*))
1317 "Makes a hash table of file dependencies for the references listed in
1318 DATABASE. This function may be useful for automatically resolving
1319 file references for automatic creation of a system definition (defsystem)."
1320 (let ((file-ref-ht (make-hash-table :test #'equal)))
1321 (maphash #'(lambda (key values)
1322 (let ((key-file (source-file key)))
1323 (when key
1324 (dolist (value values)
1325 (let ((value-file (source-file value)))
1326 (when value-file
1327 (dolist (s key-file)
1328 (dolist (d value-file)
1329 (pushnew d (gethash s file-ref-ht))))))))))
1330 database)
1331 file-ref-ht))
1332
1333 (defun print-file-dependencies (&optional (database *callers-database*))
1334 "Prints a list of file dependencies for the references listed in DATABASE.
1335 This function may be useful for automatically computing file loading
1336 constraints for a system definition tool."
1337 (maphash #'(lambda (key value) (format t "~&~S --> ~S" key value))
1338 (determine-file-dependencies database)))
1339
1340 ;;; The following functions demonstrate a possible way to interface
1341 ;;; xref to a graphical browser such as psgraph to mimic the capabilities
1342 ;;; of Masterscope's graphical browser.
1343
1344 (defvar *last-caller-tree* nil)
1345
1346 (defvar *default-graphing-mode* :call-graph
1347 "Specifies whether we graph up or down. If :call-graph, the children
1348 of a node are the functions it calls. If :caller-graph, the children
1349 of a node are the functions that call it.")
1350
1351 (defun gather-tree (parents &optional already-seen
1352 (mode *default-graphing-mode*)
1353 (types-to-ignore *types-to-ignore*) compact)
1354 "Extends the tree, copying it into list structure, until it repeats
1355 a reference (hits a cycle)."
1356 (let ((*already-seen* nil)
1357 (database (case mode
1358 (:call-graph *callees-database*)
1359 (:caller-graph *callers-database*))))
1360 (declare (special *already-seen*))
1361 (labels
1362 ((amass-tree
1363 (parents &optional already-seen)
1364 (let (result this-item)
1365 (dolist (parent parents)
1366 (unless (member (pattern-caller-type parent)
1367 types-to-ignore)
1368 (pushnew parent *already-seen*)
1369 (if (member parent already-seen)
1370 (setq this-item nil) ; :ignore
1371 (if compact
1372 (multiple-value-setq (this-item already-seen)
1373 (amass-tree (gethash parent database)
1374 (cons parent already-seen)))
1375 (setq this-item
1376 (amass-tree (gethash parent database)
1377 (cons parent already-seen)))))
1378 (setq parent (format nil "~S" parent))
1379 (when (consp parent) (setq parent (cons :xref-list parent)))
1380 (unless (eq this-item :ignore)
1381 (push (if this-item
1382 (list parent this-item)
1383 parent)
1384 result))))
1385 (values result ;(reverse result)
1386 already-seen))))
1387 (values (amass-tree parents already-seen)
1388 *already-seen*))))
1389
1390 (defun find-roots-and-cycles (&optional (mode *default-graphing-mode*)
1391 (types-to-ignore *types-to-ignore*))
1392 "Returns a list of uncalled callers (roots) and called callers (potential
1393 cycles)."
1394 (let ((uncalled-callers nil)
1395 (called-callers nil)
1396 (database (ecase mode
1397 (:call-graph *callers-database*)
1398 (:caller-graph *callees-database*)))
1399 (other-database (ecase mode
1400 (:call-graph *callees-database*)
1401 (:caller-graph *callers-database*))))
1402 (maphash #'(lambda (name value)
1403 (declare (ignore value))
1404 (unless (member (pattern-caller-type name)
1405 types-to-ignore)
1406 (if (gethash name database)
1407 (push name called-callers)
1408 (push name uncalled-callers))))
1409 other-database)
1410 (values uncalled-callers called-callers)))
1411
1412 (defun make-caller-tree (&optional (mode *default-graphing-mode*)
1413 (types-to-ignore *types-to-ignore*) compact)
1414 "Outputs list structure of a tree which roughly represents the possibly
1415 cyclical structure of the caller database.
1416 If mode is :call-graph, the children of a node are the functions it calls.
1417 If mode is :caller-graph, the children of a node are the functions that
1418 call it.
1419 If compact is T, tries to eliminate the already-seen nodes, so that
1420 the graph for a node is printed at most once. Otherwise it will duplicate
1421 the node's tree (except for cycles). This is usefull because the call tree
1422 is actually a directed graph, so we can either duplicate references or
1423 display only the first one."
1424 ;; Would be nice to print out line numbers and whenever we skip a duplicated
1425 ;; reference, print the line number of the full reference after the node.
1426 (multiple-value-bind (uncalled-callers called-callers)
1427 (find-roots-and-cycles mode types-to-ignore)
1428 (multiple-value-bind (trees already-seen)
1429 (gather-tree uncalled-callers nil mode types-to-ignore compact)
1430 (setq *last-caller-tree* trees)
1431 (let ((more-trees (gather-tree (set-difference called-callers
1432 already-seen)
1433 already-seen
1434 mode types-to-ignore compact)))
1435 (values trees more-trees)))))
1436
1437 (defvar *indent-amount* 3
1438 "Number of spaces to indent successive levels in PRINT-INDENTED-TREE.")
1439
1440 (defun print-indented-tree (trees &optional (indent 0))
1441 "Simple code to print out a list-structure tree (such as those created
1442 by make-caller-tree) as indented text."
1443 (when trees
1444 (dolist (tree trees)
1445 (cond ((and (listp tree) (eq (car tree) :xref-list))
1446 (format t "~&~VT~A" indent (cdr tree)))
1447 ((listp tree)
1448 (format t "~&~VT~A" indent (car tree))
1449 (print-indented-tree (cadr tree) (+ indent *indent-amount*)))
1450 (t
1451 (format t "~&~VT~A" indent tree))))))
1452
1453 (defun print-caller-trees (&key (mode *default-graphing-mode*)
1454 (types-to-ignore *types-to-ignore*)
1455 compact
1456 root-nodes)
1457 "Prints the calling trees (which may actually be a full graph and not
1458 necessarily a DAG) as indented text trees using PRINT-INDENTED-TREE.
1459 MODE is :call-graph for trees where the children of a node are the
1460 functions called by the node, or :caller-graph for trees where the
1461 children of a node are the functions the node calls. TYPES-TO-IGNORE
1462 is a list of funcall types (as specified in the patterns) to ignore
1463 in printing out the database. For example, '(:lisp) would ignore all
1464 calls to common lisp functions. COMPACT is a flag to tell the program
1465 to try to compact the trees a bit by not printing trees if they have
1466 already been seen. ROOT-NODES is a list of root nodes of trees to
1467 display. If ROOT-NODES is nil, tries to find all root nodes in the
1468 database."
1469 (multiple-value-bind (rooted cycles)
1470 (if root-nodes
1471 (values (gather-tree root-nodes nil mode types-to-ignore compact))
1472 (make-caller-tree mode types-to-ignore compact))
1473 (when rooted
1474 (format t "~&Rooted calling trees:")
1475 (print-indented-tree rooted 2))
1476 (when cycles
1477 (when rooted
1478 (format t "~2%"))
1479 (format t "~&Cyclic calling trees:")
1480 (print-indented-tree cycles 2))))
1481
1482
1483 ;;; ********************************
1484 ;;; Interface to PSGraph ***********
1485 ;;; ********************************
1486 #|
1487 ;;; Interface to Bates' PostScript Graphing Utility
1488 (load "/afs/cs/user/mkant/Lisp/PSGraph/psgraph")
1489
1490 (defparameter *postscript-output-directory* "")
1491 (defun psgraph-xref (&key (mode *default-graphing-mode*)
1492 (output-directory *postscript-output-directory*)
1493 (types-to-ignore *types-to-ignore*)
1494 (compact t)
1495 (shrink t)
1496 root-nodes
1497 insert)
1498 ;; If root-nodes is a non-nil list, uses that list as the starting
1499 ;; position. Otherwise tries to find all roots in the database.
1500 (multiple-value-bind (rooted cycles)
1501 (if root-nodes
1502 (values (gather-tree root-nodes nil mode types-to-ignore compact))
1503 (make-caller-tree mode types-to-ignore compact))
1504 (psgraph-output (append rooted cycles) output-directory shrink insert)))
1505
1506 (defun psgraph-output (list-of-trees directory shrink &optional insert)
1507 (let ((psgraph:*fontsize* 9)
1508 (psgraph:*second-fontsize* 7)
1509 ; (psgraph:*boxkind* "fill")
1510 (psgraph:*boxgray* "0") ; .8
1511 (psgraph:*edgewidth* "1")
1512 (psgraph:*edgegray* "0"))
1513 (labels ((stringify (thing)
1514 (cond ((stringp thing) (string-downcase thing))
1515 ((symbolp thing) (string-downcase (symbol-name thing)))
1516 ((and (listp thing) (eq (car thing) :xref-list))
1517 (stringify (cdr thing)))
1518 ((listp thing) (stringify (car thing)))
1519 (t (string thing)))))
1520 (dolist (item list-of-trees)
1521 (let* ((fname (stringify item))
1522 (filename (concatenate 'string directory
1523 (string-trim '(#\: #\|) fname)
1524 ".ps")))
1525 (format t "~&Creating PostScript file ~S." filename)
1526 (with-open-file (*standard-output* filename
1527 :direction :output
1528 :if-does-not-exist :create
1529 :if-exists :supersede)
1530 ;; Note that the #'eq prints the DAG as a tree. If
1531 ;; you replace it with #'equal, it will print it as
1532 ;; a DAG, which I think is slightly ugly.
1533 (psgraph:psgraph item
1534 #'caller-tree-children #'caller-info shrink
1535 insert #'eq)))))))
1536
1537 (defun caller-tree-children (tree)
1538 (when (and tree (listp tree) (not (eq (car tree) :xref-list)))
1539 (cadr tree)))
1540
1541 (defun caller-tree-node (tree)
1542 (when tree
1543 (cond ((and (listp tree) (eq (car tree) :xref-list))
1544 (cdr tree))
1545 ((listp tree)
1546 (car tree))
1547 (t
1548 tree))))
1549
1550 (defun caller-info (tree)
1551 (let ((node (caller-tree-node tree)))
1552 (list node)))
1553 |#
1554 #|
1555 ;;; Code to print out graphical trees of CLOS class hierarchies.
1556 (defun print-class-hierarchy (&optional (start-class 'anything)
1557 (file "classes.ps"))
1558 (let ((start (find-class start-class)))
1559 (when start
1560 (with-open-file (*standard-output* file :direction :output)
1561 (psgraph:psgraph start
1562 #'clos::class-direct-subclasses
1563 #'(lambda (x)
1564 (list (format nil "~A" (clos::class-name x))))
1565 t nil #'eq)))))
1566
1567 |#
1568
1569
1570 ;;; ****************************************************************
1571 ;;; Cross Referencing Patterns for Common Lisp *********************
1572 ;;; ****************************************************************
1573 (clear-patterns)
1574
1575 ;;; ********************************
1576 ;;; Pattern Substitutions **********
1577 ;;; ********************************
1578 (define-pattern-substitution integer (:test #'integerp))
1579 (define-pattern-substitution rational (:test #'rationalp))
1580 (define-pattern-substitution symbol (:test #'symbolp))
1581 (define-pattern-substitution string (:test #'stringp))
1582 (define-pattern-substitution number (:test #'numberp))
1583 (define-pattern-substitution lambda-list
1584 ((:star var)
1585 (:optional (:eq &optional)
1586 (:star (:or var
1587 (var (:optional form (:optional var))))))
1588 (:optional (:eq &rest) var)
1589 (:optional (:eq &key) (:star (:or var
1590 ((:or var
1591 (keyword var))
1592 (:optional form (:optional var)))))
1593 (:optional &allow-other-keys))
1594 (:optional (:eq &aux)
1595 (:star (:or var
1596 (var (:optional form)))))))
1597 (define-pattern-substitution test form)
1598 (define-pattern-substitution body
1599 ((:star (:or declaration documentation-string))
1600 (:star form)))
1601 (define-pattern-substitution documentation-string string)
1602 (define-pattern-substitution initial-value form)
1603 (define-pattern-substitution tag symbol)
1604 (define-pattern-substitution declaration ((:eq declare)(:rest :ignore)))
1605 (define-pattern-substitution destination form)
1606 (define-pattern-substitution control-string string)
1607 (define-pattern-substitution format-arguments
1608 ((:star form)))
1609 (define-pattern-substitution fn
1610 (:or ((:eq quote) function)
1611 ((:eq function) function)
1612 function))
1613
1614 ;;; ********************************
1615 ;;; Caller Patterns ****************
1616 ;;; ********************************
1617
1618 ;;; Types Related
1619 (define-caller-pattern coerce (form :ignore) :lisp)
1620 (define-caller-pattern type-of (form) :lisp)
1621 (define-caller-pattern upgraded-array-element-type (:ignore) :lisp2)
1622 (define-caller-pattern upgraded-complex-part-type (:ignore) :lisp2)
1623
1624 ;;; Lambdas and Definitions
1625 (define-variable-pattern lambda-list-keywords :lisp)
1626 (define-variable-pattern lambda-parameters-limit :lisp)
1627 (define-caller-pattern lambda (lambda-list (:rest body)) :lisp)
1628
1629 (define-caller-pattern defun
1630 (name lambda-list
1631 (:star (:or documentation-string declaration))
1632 (:star form))
1633 :lisp)
1634
1635 ;;; perhaps this should use VAR, instead of NAME
1636 (define-caller-pattern defvar
1637 (var (:optional initial-value (:optional documentation-string)))
1638 :lisp)
1639 (define-caller-pattern defparameter
1640 (var initial-value (:optional documentation-string))
1641 :lisp)
1642 (define-caller-pattern defconstant
1643 (var initial-value (:optional documentation-string))
1644 :lisp)
1645
1646 (define-caller-pattern eval-when
1647 (:ignore ; the situations
1648 (:star form))
1649 :lisp)
1650
1651 ;;; Logical Values
1652 (define-variable-pattern nil :lisp)
1653 (define-variable-pattern t :lisp)
1654
1655 ;;; Predicates
1656 (define-caller-pattern typep (form form) :lisp)
1657 (define-caller-pattern subtypep (form form) :lisp)
1658
1659 (define-caller-pattern null (form) :lisp)
1660 (define-caller-pattern symbolp (form) :lisp)
1661 (define-caller-pattern atom (form) :lisp)
1662 (define-caller-pattern consp (form) :lisp)
1663 (define-caller-pattern listp (form) :lisp)
1664 (define-caller-pattern numberp (form) :lisp)
1665 (define-caller-pattern integerp (form) :lisp)
1666 (define-caller-pattern rationalp (form) :lisp)
1667 (define-caller-pattern floatp (form) :lisp)
1668 (define-caller-pattern realp (form) :lisp2)
1669 (define-caller-pattern complexp (form) :lisp)
1670 (define-caller-pattern characterp (form) :lisp)
1671 (define-caller-pattern stringp (form) :lisp)
1672 (define-caller-pattern bit-vector-p (form) :lisp)
1673 (define-caller-pattern vectorp (form) :lisp)
1674 (define-caller-pattern simple-vector-p (form) :lisp)
1675 (define-caller-pattern simple-string-p (form) :lisp)
1676 (define-caller-pattern simple-bit-vector-p (form) :lisp)
1677 (define-caller-pattern arrayp (form) :lisp)
1678 (define-caller-pattern packagep (form) :lisp)
1679 (define-caller-pattern functionp (form) :lisp)
1680 (define-caller-pattern compiled-function-p (form) :lisp)
1681 (define-caller-pattern commonp (form) :lisp)
1682
1683 ;;; Equality Predicates
1684 (define-caller-pattern eq (form form) :lisp)
1685 (define-caller-pattern eql (form form) :lisp)
1686 (define-caller-pattern equal (form form) :lisp)
1687 (define-caller-pattern equalp (form form) :lisp)
1688
1689 ;;; Logical Operators
1690 (define-caller-pattern not (form) :lisp)
1691 (define-caller-pattern or ((:star form)) :lisp)
1692 (define-caller-pattern and ((:star form)) :lisp)
1693
1694 ;;; Reference
1695
1696 ;;; Quote is a problem. In Defmacro & friends, we'd like to actually
1697 ;;; look at the argument, 'cause it hides internal function calls
1698 ;;; of the defmacro.
1699 (define-caller-pattern quote (:ignore) :lisp)
1700
1701 (define-caller-pattern function ((:or fn form)) :lisp)
1702 (define-caller-pattern symbol-value (form) :lisp)
1703 (define-caller-pattern symbol-function (form) :lisp)
1704 (define-caller-pattern fdefinition (form) :lisp2)
1705 (define-caller-pattern boundp (form) :lisp)
1706 (define-caller-pattern fboundp (form) :lisp)
1707 (define-caller-pattern special-form-p (form) :lisp)
1708
1709 ;;; Assignment
1710 (define-caller-pattern setq ((:star var form)) :lisp)
1711 (define-caller-pattern psetq ((:star var form)) :lisp)
1712 (define-caller-pattern set (form form) :lisp)
1713 (define-caller-pattern makunbound (form) :lisp)
1714 (define-caller-pattern fmakunbound (form) :lisp)
1715
1716 ;;; Generalized Variables
1717 (define-caller-pattern setf ((:star form form)) :lisp)
1718 (define-caller-pattern psetf ((:star form form)) :lisp)
1719 (define-caller-pattern shiftf ((:plus form) form) :lisp)
1720 (define-caller-pattern rotatef ((:star form)) :lisp)
1721 (define-caller-pattern define-modify-macro
1722 (name
1723 lambda-list
1724 fn
1725 (:optional documentation-string))
1726 :lisp)
1727 (define-caller-pattern defsetf
1728 (:or (name name (:optional documentation-string))
1729 (name lambda-list (var)
1730 (:star (:or declaration documentation-string))
1731 (:star form)))
1732 :lisp)
1733 (define-caller-pattern define-setf-method
1734 (name lambda-list
1735 (:star (:or declaration documentation-string))
1736 (:star form))
1737 :lisp)
1738 (define-caller-pattern get-setf-method (form) :lisp)
1739 (define-caller-pattern get-setf-method-multiple-value (form) :lisp)
1740
1741
1742 ;;; Function invocation
1743 (define-caller-pattern apply (fn form (:star form)) :lisp)
1744 (define-caller-pattern funcall (fn (:star form)) :lisp)
1745
1746
1747 ;;; Simple sequencing
1748 (define-caller-pattern progn ((:star form)) :lisp)
1749 (define-caller-pattern prog1 (form (:star form)) :lisp)
1750 (define-caller-pattern prog2 (form form (:star form)) :lisp)
1751
1752 ;;; Variable bindings
1753 (define-caller-pattern let
1754 (((:star (:or var (var &optional form))))
1755 (:star declaration)
1756 (:star form))
1757 :lisp)
1758 (define-caller-pattern let*
1759 (((:star (:or var (var &optional form))))
1760 (:star declaration)
1761 (:star form))
1762 :lisp)
1763 (define-caller-pattern compiler-let
1764 (((:star (:or var (var form))))
1765 (:star form))
1766 :lisp)
1767 (define-caller-pattern progv
1768 (form form (:star form)) :lisp)
1769 (define-caller-pattern flet
1770 (((:star (name lambda-list
1771 (:star (:or declaration
1772 documentation-string))
1773 (:star form))))
1774 (:star form))
1775 :lisp)
1776 (define-caller-pattern labels
1777 (((:star (name lambda-list
1778 (:star (:or declaration
1779 documentation-string))
1780 (:star form))))
1781 (:star form))
1782 :lisp)
1783 (define-caller-pattern macrolet
1784 (((:star (name lambda-list
1785 (:star (:or declaration
1786 documentation-string))
1787 (:star form))))
1788 (:star form))
1789 :lisp)
1790 (define-caller-pattern symbol-macrolet
1791 (((:star (var form))) (:star declaration) (:star form))
1792 :lisp2)
1793
1794 ;;; Conditionals
1795 (define-caller-pattern if (test form (:optional form)) :lisp)
1796 (define-caller-pattern when (test (:star form)) :lisp)
1797 (define-caller-pattern unless (test (:star form)) :lisp)
1798 (define-caller-pattern cond ((:star (test (:star form)))) :lisp)
1799 (define-caller-pattern case
1800 (form
1801 (:star ((:or symbol
1802 ((:star symbol)))
1803 (:star form))))
1804 :lisp)
1805 (define-caller-pattern typecase (form (:star (symbol (:star form))))
1806 :lisp)
1807
1808 ;;; Blocks and Exits
1809 (define-caller-pattern block (name (:star form)) :lisp)
1810 (define-caller-pattern return-from (function (:optional form)) :lisp)
1811 (define-caller-pattern return ((:optional form)) :lisp)
1812
1813 ;;; Iteration
1814 (define-caller-pattern loop ((:star form)) :lisp)
1815 (define-caller-pattern do
1816 (((:star (:or var
1817 (var (:optional form (:optional form)))))) ; init step
1818 (form (:star form)) ; end-test result
1819 (:star declaration)
1820 (:star (:or tag form))) ; statement
1821 :lisp)
1822 (define-caller-pattern do*
1823 (((:star (:or var
1824 (var (:optional form (:optional form))))))
1825 (form (:star form))
1826 (:star declaration)
1827 (:star (:or tag form)))
1828 :lisp)
1829 (define-caller-pattern dolist
1830 ((var form (:optional form))
1831 (:star declaration)
1832 (:star (:or tag form)))
1833 :lisp)
1834 (define-caller-pattern dotimes
1835 ((var form (:optional form))
1836 (:star declaration)
1837 (:star (:or tag form)))
1838 :lisp)
1839
1840 ;;; Mapping
1841 (define-caller-pattern mapcar (fn form (:star form)) :lisp)
1842 (define-caller-pattern maplist (fn form (:star form)) :lisp)
1843 (define-caller-pattern mapc (fn form (:star form)) :lisp)
1844 (define-caller-pattern mapl (fn form (:star form)) :lisp)
1845 (define-caller-pattern mapcan (fn form (:star form)) :lisp)
1846 (define-caller-pattern mapcon (fn form (:star form)) :lisp)
1847
1848 ;;; The "Program Feature"
1849 (define-caller-pattern tagbody ((:star (:or tag form))) :lisp)
1850 (define-caller-pattern prog
1851 (((:star (:or var (var (:optional form)))))
1852 (:star declaration)
1853 (:star (:or tag form)))
1854 :lisp)
1855 (define-caller-pattern prog*
1856 (((:star (:or var (var (:optional form)))))
1857 (:star declaration)
1858 (:star (:or tag form)))
1859 :lisp)
1860 (define-caller-pattern go (tag) :lisp)
1861
1862 ;;; Multiple Values
1863 (define-caller-pattern values ((:star form)) :lisp)
1864 (define-variable-pattern multiple-values-limit :lisp)
1865 (define-caller-pattern values-list (form) :lisp)
1866 (define-caller-pattern multiple-value-list (form) :lisp)
1867 (define-caller-pattern multiple-value-call (fn (:star form)) :lisp)
1868 (define-caller-pattern multiple-value-prog1 (form (:star form)) :lisp)
1869 (define-caller-pattern multiple-value-bind
1870 (((:star var)) form
1871 (:star declaration)
1872 (:star form))
1873 :lisp)
1874 (define-caller-pattern multiple-value-setq (((:star var)) form) :lisp)
1875 (define-caller-pattern nth-value (form form) :lisp2)
1876
1877 ;;; Dynamic Non-Local Exits
1878 (define-caller-pattern catch (tag (:star form)) :lisp)
1879 (define-caller-pattern throw (tag form) :lisp)
1880 (define-caller-pattern unwind-protect (form (:star form)) :lisp)
1881
1882 ;;; Macros
1883 (define-caller-pattern macro-function (form) :lisp)
1884 (define-caller-pattern defmacro
1885 (name
1886 lambda-list
1887 (:star (:or declaration documentation-string))
1888 (:star form))
1889 :lisp)
1890 (define-caller-pattern macroexpand (form (:optional :ignore)) :lisp)
1891 (define-caller-pattern macroexpand-1 (form (:optional :ignore)) :lisp)
1892 (define-variable-pattern *macroexpand-hook* :lisp)
1893
1894 ;;; Destructuring
1895 (define-caller-pattern destructuring-bind
1896 (lambda-list form
1897 (:star declaration)
1898 (:star form))
1899 :lisp2)
1900
1901 ;;; Compiler Macros
1902 (define-caller-pattern define-compiler-macro
1903 (name lambda-list
1904 (:star (:or declaration documentation-string))
1905 (:star form))
1906 :lisp2)
1907 (define-caller-pattern compiler-macro-function (form) :lisp2)
1908 (define-caller-pattern compiler-macroexpand (form (:optional :ignore)) :lisp2)
1909 (define-caller-pattern compiler-macroexpand-1 (form (:optional :ignore)) :lisp2)
1910
1911 ;;; Environments
1912 (define-caller-pattern variable-information (form &optional :ignore)
1913 :lisp2)
1914 (define-caller-pattern function-information (fn &optional :ignore) :lisp2)
1915 (define-caller-pattern declaration-information (form &optional :ignore) :lisp2)
1916 (define-caller-pattern augment-environment (form &key (:star :ignore)) :lisp2)
1917 (define-caller-pattern define-declaration
1918 (name
1919 lambda-list
1920 (:star form))
1921 :lisp2)
1922 (define-caller-pattern parse-macro (name lambda-list form) :lisp2)
1923 (define-caller-pattern enclose (form &optional :ignore) :lisp2)
1924
1925
1926 ;;; Declarations
1927 (define-caller-pattern declare ((:rest :ignore)) :lisp)
1928 (define-caller-pattern proclaim ((:rest :ignore)) :lisp)
1929 (define-caller-pattern locally ((:star declaration) (:star form)) :lisp)
1930 (define-caller-pattern declaim ((:rest :ignore)) :lisp2)
1931 (define-caller-pattern the (form form) :lisp)
1932
1933 ;;; Symbols
1934 (define-caller-pattern get (form form (:optional form)) :lisp)
1935 (define-caller-pattern remprop (form form) :lisp)
1936 (define-caller-pattern symbol-plist (form) :lisp)
1937 (define-caller-pattern getf (form form (:optional form)) :lisp)
1938 (define-caller-pattern remf (form form) :lisp)
1939 (define-caller-pattern get-properties (form form) :lisp)
1940
1941 (define-caller-pattern symbol-name (form) :lisp)
1942 (define-caller-pattern make-symbol (form) :lisp)
1943 (define-caller-pattern copy-symbol (form (:optional :ignore)) :lisp)
1944 (define-caller-pattern gensym ((:optional :ignore)) :lisp)
1945 (define-variable-pattern *gensym-counter* :lisp2)
1946 (define-caller-pattern gentemp ((:optional :ignore :ignore)) :lisp)
1947 (define-caller-pattern symbol-package (form) :lisp)
1948 (define-caller-pattern keywordp (form) :lisp)
1949
1950 ;;; Packages
1951 (define-variable-pattern *package* :lisp)
1952 (define-caller-pattern make-package ((:rest :ignore)) :lisp)
1953 (define-caller-pattern in-package ((:rest :ignore)) :lisp)
1954 (define-caller-pattern find-package ((:rest :ignore)) :lisp)
1955 (define-caller-pattern package-name ((:rest :ignore)) :lisp)
1956 (define-caller-pattern package-nicknames ((:rest :ignore)) :lisp)
1957 (define-caller-pattern rename-package ((:rest :ignore)) :lisp)
1958 (define-caller-pattern package-use-list ((:rest :ignore)) :lisp)
1959 (define-caller-pattern package-used-by-list ((:rest :ignore)) :lisp)
1960 (define-caller-pattern package-shadowing-symbols ((:rest :ignore)) :lisp)
1961 (define-caller-pattern list-all-packages () :lisp)
1962 (define-caller-pattern delete-package ((:rest :ignore)) :lisp2)
1963 (define-caller-pattern intern (form &optional :ignore) :lisp)
1964 (define-caller-pattern find-symbol (form &optional :ignore) :lisp)
1965 (define-caller-pattern unintern (form &optional :ignore) :lisp)
1966
1967 (define-caller-pattern export ((:or symbol ((:star symbol)))
1968 &optional :ignore) :lisp)
1969 (define-caller-pattern unexport ((:or symbol ((:star symbol)))
1970 &optional :ignore) :lisp)
1971 (define-caller-pattern import ((:or symbol ((:star symbol)))
1972 &optional :ignore) :lisp)
1973 (define-caller-pattern shadowing-import ((:or symbol ((:star symbol)))
1974 &optional :ignore) :lisp)
1975 (define-caller-pattern shadow ((:or symbol ((:star symbol)))
1976 &optional :ignore) :lisp)
1977
1978 (define-caller-pattern use-package ((:rest :ignore)) :lisp)
1979 (define-caller-pattern unuse-package ((:rest :ignore)) :lisp)
1980 (define-caller-pattern defpackage (name (:rest :ignore)) :lisp2)
1981 (define-caller-pattern find-all-symbols (form) :lisp)
1982 (define-caller-pattern do-symbols
1983 ((var (:optional form (:optional form)))
1984 (:star declaration)
1985 (:star (:or tag form)))
1986 :lisp)
1987 (define-caller-pattern do-external-symbols
1988 ((var (:optional form (:optional form)))
1989 (:star declaration)
1990 (:star (:or tag form)))
1991 :lisp)
1992 (define-caller-pattern do-all-symbols
1993 ((var (:optional form))
1994 (:star declaration)
1995 (:star (:or tag form)))
1996 :lisp)
1997 (define-caller-pattern with-package-iterator
1998 ((name form (:plus :ignore))
1999 (:star form))
2000 :lisp2)
2001
2002 ;;; Modules
2003 (define-variable-pattern *modules* :lisp)
2004 (define-caller-pattern provide (form) :lisp)
2005 (define-caller-pattern require (form &optional :ignore) :lisp)
2006
2007
2008 ;;; Numbers
2009 (define-caller-pattern zerop (form) :lisp)
2010 (define-caller-pattern plusp (form) :lisp)
2011 (define-caller-pattern minusp (form) :lisp)
2012 (define-caller-pattern oddp (form) :lisp)
2013 (define-caller-pattern evenp (form) :lisp)
2014
2015 (define-caller-pattern = (form (:star form)) :lisp)
2016 (define-caller-pattern /= (form (:star form)) :lisp)
2017 (define-caller-pattern > (form (:star form)) :lisp)
2018 (define-caller-pattern < (form (:star form)) :lisp)
2019 (define-caller-pattern <= (form (:star form)) :lisp)
2020 (define-caller-pattern >= (form (:star form)) :lisp)
2021
2022 (define-caller-pattern max (form (:star form)) :lisp)
2023 (define-caller-pattern min (form (:star form)) :lisp)
2024
2025 (define-caller-pattern - (form (:star form)) :lisp)
2026 (define-caller-pattern + (form (:star form)) :lisp)
2027 (define-caller-pattern * (form (:star form)) :lisp)
2028 (define-caller-pattern / (form (:star form)) :lisp)
2029 (define-caller-pattern 1+ (form) :lisp)
2030 (define-caller-pattern 1- (form) :lisp)
2031
2032 (define-caller-pattern incf (form form) :lisp)
2033 (define-caller-pattern decf (form form) :lisp)
2034
2035 (define-caller-pattern conjugate (form) :lisp)
2036
2037 (define-caller-pattern gcd ((:star form)) :lisp)
2038 (define-caller-pattern lcm ((:star form)) :lisp)
2039
2040 (define-caller-pattern exp (form) :lisp)
2041 (define-caller-pattern expt (form form) :lisp)
2042 (define-caller-pattern log (form (:optional form)) :lisp)
2043 (define-caller-pattern sqrt (form) :lisp)
2044 (define-caller-pattern isqrt (form) :lisp)
2045
2046 (define-caller-pattern abs (form) :lisp)
2047 (define-caller-pattern phase (form) :lisp)
2048 (define-caller-pattern signum (form) :lisp)
2049 (define-caller-pattern sin (form) :lisp)
2050 (define-caller-pattern cos (form) :lisp)
2051 (define-caller-pattern tan (form) :lisp)
2052 (define-caller-pattern cis (form) :lisp)
2053 (define-caller-pattern asin (form) :lisp)
2054 (define-caller-pattern acos (form) :lisp)
2055 (define-caller-pattern atan (form &optional form) :lisp)
2056 (define-variable-pattern pi :lisp)
2057
2058 (define-caller-pattern sinh (form) :lisp)
2059 (define-caller-pattern cosh (form) :lisp)
2060 (define-caller-pattern tanh (form) :lisp)
2061 (define-caller-pattern asinh (form) :lisp)
2062 (define-caller-pattern acosh (form) :lisp)
2063 (define-caller-pattern atanh (form) :lisp)
2064
2065 ;;; Type Conversions and Extractions
2066 (define-caller-pattern float (form (:optional form)) :lisp)
2067 (define-caller-pattern rational (form) :lisp)
2068 (define-caller-pattern rationalize (form) :lisp)
2069 (define-caller-pattern numerator (form) :lisp)
2070 (define-caller-pattern denominator (form) :lisp)
2071
2072 (define-caller-pattern floor (form (:optional form)) :lisp)
2073 (define-caller-pattern ceiling (form (:optional form)) :lisp)
2074 (define-caller-pattern truncate (form (:optional form)) :lisp)
2075 (define-caller-pattern round (form (:optional form)) :lisp)
2076
2077 (define-caller-pattern mod (form form) :lisp)
2078 (define-caller-pattern rem (form form) :lisp)
2079
2080 (define-caller-pattern ffloor (form (:optional form)) :lisp)
2081 (define-caller-pattern fceiling (form (:optional form)) :lisp)
2082 (define-caller-pattern ftruncate (form (:optional form)) :lisp)
2083 (define-caller-pattern fround (form (:optional form)) :lisp)
2084
2085 (define-caller-pattern decode-float (form) :lisp)
2086 (define-caller-pattern scale-float (form form) :lisp)
2087 (define-caller-pattern float-radix (form) :lisp)
2088 (define-caller-pattern float-sign (form (:optional form)) :lisp)
2089 (define-caller-pattern float-digits (form) :lisp)
2090 (define-caller-pattern float-precision (form) :lisp)
2091 (define-caller-pattern integer-decode-float (form) :lisp)
2092
2093 (define-caller-pattern complex (form (:optional form)) :lisp)
2094 (define-caller-pattern realpart (form) :lisp)
2095 (define-caller-pattern imagpart (form) :lisp)
2096
2097 (define-caller-pattern logior ((:star form)) :lisp)
2098 (define-caller-pattern logxor ((:star form)) :lisp)
2099 (define-caller-pattern logand ((:star form)) :lisp)
2100 (define-caller-pattern logeqv ((:star form)) :lisp)
2101
2102 (define-caller-pattern lognand (form form) :lisp)
2103 (define-caller-pattern lognor (form form) :lisp)
2104 (define-caller-pattern logandc1 (form form) :lisp)
2105 (define-caller-pattern logandc2 (form form) :lisp)
2106 (define-caller-pattern logorc1 (form form) :lisp)
2107 (define-caller-pattern logorc2 (form form) :lisp)
2108
2109 (define-caller-pattern boole (form form form) :lisp)
2110 (define-variable-pattern boole-clr :lisp)
2111 (define-variable-pattern boole-set :lisp)
2112 (define-variable-pattern boole-1 :lisp)
2113 (define-variable-pattern boole-2 :lisp)
2114 (define-variable-pattern boole-c1 :lisp)
2115 (define-variable-pattern boole-c2 :lisp)
2116 (define-variable-pattern boole-and :lisp)
2117 (define-variable-pattern boole-ior :lisp)
2118 (define-variable-pattern boole-xor :lisp)
2119 (define-variable-pattern boole-eqv :lisp)
2120 (define-variable-pattern boole-nand :lisp)
2121 (define-variable-pattern boole-nor :lisp)
2122 (define-variable-pattern boole-andc1 :lisp)
2123 (define-variable-pattern boole-andc2 :lisp)
2124 (define-variable-pattern boole-orc1 :lisp)
2125 (define-variable-pattern boole-orc2 :lisp)
2126
2127 (define-caller-pattern lognot (form) :lisp)
2128 (define-caller-pattern logtest (form form) :lisp)
2129 (define-caller-pattern logbitp (form form) :lisp)
2130 (define-caller-pattern ash (form form) :lisp)
2131 (define-caller-pattern logcount (form) :lisp)
2132 (define-caller-pattern integer-length (form) :lisp)
2133
2134 (define-caller-pattern byte (form form) :lisp)
2135 (define-caller-pattern byte-size (form) :lisp)
2136 (define-caller-pattern byte-position (form) :lisp)
2137 (define-caller-pattern ldb (form form) :lisp)
2138 (define-caller-pattern ldb-test (form form) :lisp)
2139 (define-caller-pattern mask-field (form form) :lisp)
2140 (define-caller-pattern dpb (form form form) :lisp)
2141 (define-caller-pattern deposit-field (form form form) :lisp)
2142
2143 ;;; Random Numbers
2144 (define-caller-pattern random (form (:optional form)) :lisp)
2145 (define-variable-pattern *random-state* :lisp)
2146 (define-caller-pattern make-random-state ((:optional form)) :lisp)
2147 (define-caller-pattern random-state-p (form) :lisp)
2148
2149 ;;; Implementation Parameters
2150 (define-variable-pattern most-positive-fixnum :lisp)
2151 (define-variable-pattern most-negative-fixnum :lisp)
2152 (define-variable-pattern most-positive-short-float :lisp)
2153 (define-variable-pattern least-positive-short-float :lisp)
2154 (define-variable-pattern least-negative-short-float :lisp)
2155 (define-variable-pattern most-negative-short-float :lisp)
2156 (define-variable-pattern most-positive-single-float :lisp)
2157 (define-variable-pattern least-positive-single-float :lisp)
2158 (define-variable-pattern least-negative-single-float :lisp)
2159 (define-variable-pattern most-negative-single-float :lisp)
2160 (define-variable-pattern most-positive-double-float :lisp)
2161 (define-variable-pattern least-positive-double-float :lisp)
2162 (define-variable-pattern least-negative-double-float :lisp)
2163 (define-variable-pattern most-negative-double-float :lisp)
2164 (define-variable-pattern most-positive-long-float :lisp)
2165 (define-variable-pattern least-positive-long-float :lisp)
2166 (define-variable-pattern least-negative-long-float :lisp)
2167 (define-variable-pattern most-negative-long-float :lisp)
2168 (define-variable-pattern least-positive-normalized-short-float :lisp2)
2169 (define-variable-pattern least-negative-normalized-short-float :lisp2)
2170 (define-variable-pattern least-positive-normalized-single-float :lisp2)
2171 (define-variable-pattern least-negative-normalized-single-float :lisp2)
2172 (define-variable-pattern least-positive-normalized-double-float :lisp2)
2173 (define-variable-pattern least-negative-normalized-double-float :lisp2)
2174 (define-variable-pattern least-positive-normalized-long-float :lisp2)
2175 (define-variable-pattern least-negative-normalized-long-float :lisp2)
2176 (define-variable-pattern short-float-epsilon :lisp)
2177 (define-variable-pattern single-float-epsilon :lisp)
2178 (define-variable-pattern double-float-epsilon :lisp)
2179 (define-variable-pattern long-float-epsilon :lisp)
2180 (define-variable-pattern short-float-negative-epsilon :lisp)
2181 (define-variable-pattern single-float-negative-epsilon :lisp)
2182 (define-variable-pattern double-float-negative-epsilon :lisp)
2183 (define-variable-pattern long-float-negative-epsilon :lisp)
2184
2185 ;;; Characters
2186 (define-variable-pattern char-code-limit :lisp)
2187 (define-variable-pattern char-font-limit :lisp)
2188 (define-variable-pattern char-bits-limit :lisp)
2189 (define-caller-pattern standard-char-p (form) :lisp)
2190 (define-caller-pattern graphic-char-p (form) :lisp)
2191 (define-caller-pattern string-char-p (form) :lisp)
2192 (define-caller-pattern alpha-char-p (form) :lisp)
2193 (define-caller-pattern upper-case-p (form) :lisp)
2194 (define-caller-pattern lower-case-p (form) :lisp)
2195 (define-caller-pattern both-case-p (form) :lisp)
2196 (define-caller-pattern digit-char-p (form (:optional form)) :lisp)
2197 (define-caller-pattern alphanumericp (form) :lisp)
2198
2199 (define-caller-pattern char= ((:star form)) :lisp)
2200 (define-caller-pattern char/= ((:star form)) :lisp)
2201 (define-caller-pattern char< ((:star form)) :lisp)
2202 (define-caller-pattern char> ((:star form)) :lisp)
2203 (define-caller-pattern char<= ((:star form)) :lisp)
2204 (define-caller-pattern char>= ((:star form)) :lisp)
2205
2206 (define-caller-pattern char-equal ((:star form)) :lisp)
2207 (define-caller-pattern char-not-equal ((:star form)) :lisp)
2208 (define-caller-pattern char-lessp ((:star form)) :lisp)
2209 (define-caller-pattern char-greaterp ((:star form)) :lisp)
2210 (define-caller-pattern char-not-greaterp ((:star form)) :lisp)
2211 (define-caller-pattern char-not-lessp ((:star form)) :lisp)
2212
2213 (define-caller-pattern char-code (form) :lisp)
2214 (define-caller-pattern char-bits (form) :lisp)
2215 (define-caller-pattern char-font (form) :lisp)
2216 (define-caller-pattern code-char (form (:optional form form)) :lisp)
2217 (define-caller-pattern make-char (form (:optional form form)) :lisp)
2218 (define-caller-pattern characterp (form) :lisp)
2219 (define-caller-pattern char-upcase (form) :lisp)
2220 (define-caller-pattern char-downcase (form) :lisp)
2221 (define-caller-pattern digit-char (form (:optional form form)) :lisp)
2222 (define-caller-pattern char-int (form) :lisp)
2223 (define-caller-pattern int-char (form) :lisp)
2224 (define-caller-pattern char-name (form) :lisp)
2225 (define-caller-pattern name-char (form) :lisp)
2226 (define-variable-pattern char-control-bit :lisp)
2227 (define-variable-pattern char-meta-bit :lisp)
2228 (define-variable-pattern char-super-bit :lisp)
2229 (define-variable-pattern char-hyper-bit :lisp)
2230 (define-caller-pattern char-bit (form form) :lisp)
2231 (define-caller-pattern set-char-bit (form form form) :lisp)
2232
2233 ;;; Sequences
2234 (define-caller-pattern complement (fn) :lisp2)
2235 (define-caller-pattern elt (form form) :lisp)
2236 (define-caller-pattern subseq (form form &optional form) :lisp)
2237 (define-caller-pattern copy-seq (form) :lisp)
2238 (define-caller-pattern length (form) :lisp)
2239 (define-caller-pattern reverse (form) :lisp)
2240 (define-caller-pattern nreverse (form) :lisp)
2241 (define-caller-pattern make-sequence (form form &key form) :lisp)
2242
2243 (define-caller-pattern concatenate (form (:star form)) :lisp)
2244 (define-caller-pattern map (form fn form (:star form)) :lisp)
2245 (define-caller-pattern map-into (form fn (:star form)) :lisp2)
2246
2247 (define-caller-pattern some (fn form (:star form)) :lisp)
2248 (define-caller-pattern every (fn form (:star form)) :lisp)
2249 (define-caller-pattern notany (fn form (:star form)) :lisp)
2250 (define-caller-pattern notevery (fn form (:star form)) :lisp)
2251
2252 (define-caller-pattern reduce (fn form &key (:star form)) :lisp)
2253 (define-caller-pattern fill (form form &key (:star form)) :lisp)
2254 (define-caller-pattern replace (form form &key (:star form)) :lisp)
2255 (define-caller-pattern remove (form form &key (:star form)) :lisp)
2256 (define-caller-pattern remove-if (fn form &key (:star form)) :lisp)
2257 (define-caller-pattern remove-if-not (fn form &key (:star form)) :lisp)
2258 (define-caller-pattern delete (form form &key (:star form)) :lisp)
2259 (define-caller-pattern delete-if (fn form &key (:star form)) :lisp)
2260 (define-caller-pattern delete-if-not (fn form &key (:star form)) :lisp)
2261 (define-caller-pattern remove-duplicates (form &key (:star form)) :lisp)
2262 (define-caller-pattern delete-duplicates (form &key (:star form)) :lisp)
2263 (define-caller-pattern substitute (form form form &key (:star form)) :lisp)
2264 (define-caller-pattern substitute-if (form fn form &key (:star form)) :lisp)
2265 (define-caller-pattern substitute-if-not (form fn form &key (:star form)) :lisp)
2266 (define-caller-pattern nsubstitute (form form form &key (:star form)) :lisp)
2267 (define-caller-pattern nsubstitute-if (form fn form &key (:star form)) :lisp)
2268 (define-caller-pattern nsubstitute-if-not (form fn form &key (:star form)) :lisp)
2269 (define-caller-pattern find (form form &key (:star form)) :lisp)
2270 (define-caller-pattern find-if (fn form &key (:star form)) :lisp)
2271 (define-caller-pattern find-if-not (fn form &key (:star form)) :lisp)
2272 (define-caller-pattern position (form form &key (:star form)) :lisp)
2273 (define-caller-pattern position-if (fn form &key (:star form)) :lisp)
2274 (define-caller-pattern position-if-not (fn form &key (:star form)) :lisp)
2275 (define-caller-pattern count (form form &key (:star form)) :lisp)
2276 (define-caller-pattern count-if (fn form &key (:star form)) :lisp)
2277 (define-caller-pattern count-if-not (fn form &key (:star form)) :lisp)
2278 (define-caller-pattern mismatch (form form &key (:star form)) :lisp)
2279 (define-caller-pattern search (form form &key (:star form)) :lisp)
2280 (define-caller-pattern sort (form fn &key (:star form)) :lisp)
2281 (define-caller-pattern stable-sort (form fn &key (:star form)) :lisp)
2282 (define-caller-pattern merge (form form form fn &key (:star form)) :lisp)
2283
2284 ;;; Lists
2285 (define-caller-pattern car (form) :lisp)
2286 (define-caller-pattern cdr (form) :lisp)
2287 (define-caller-pattern caar (form) :lisp)
2288 (define-caller-pattern cadr (form) :lisp)
2289 (define-caller-pattern cdar (form) :lisp)
2290 (define-caller-pattern cddr (form) :lisp)
2291 (define-caller-pattern caaar (form) :lisp)
2292 (define-caller-pattern caadr (form) :lisp)
2293 (define-caller-pattern cadar (form) :lisp)
2294 (define-caller-pattern caddr (form) :lisp)
2295 (define-caller-pattern cdaar (form) :lisp)
2296 (define-caller-pattern cdadr (form) :lisp)
2297 (define-caller-pattern cddar (form) :lisp)
2298 (define-caller-pattern cdddr (form) :lisp)
2299 (define-caller-pattern caaaar (form) :lisp)
2300 (define-caller-pattern caaadr (form) :lisp)
2301 (define-caller-pattern caadar (form) :lisp)
2302 (define-caller-pattern caaddr (form) :lisp)
2303 (define-caller-pattern cadaar (form) :lisp)
2304 (define-caller-pattern cadadr (form) :lisp)
2305 (define-caller-pattern caddar (form) :lisp)
2306 (define-caller-pattern cadddr (form) :lisp)
2307 (define-caller-pattern cdaaar (form) :lisp)
2308 (define-caller-pattern cdaadr (form) :lisp)
2309 (define-caller-pattern cdadar (form) :lisp)
2310 (define-caller-pattern cdaddr (form) :lisp)
2311 (define-caller-pattern cddaar (form) :lisp)
2312 (define-caller-pattern cddadr (form) :lisp)
2313 (define-caller-pattern cdddar (form) :lisp)
2314 (define-caller-pattern cddddr (form) :lisp)
2315
2316 (define-caller-pattern cons (form form) :lisp)
2317 (define-caller-pattern tree-equal (form form &key (:star fn)) :lisp)
2318 (define-caller-pattern endp (form) :lisp)
2319 (define-caller-pattern list-length (form) :lisp)
2320 (define-caller-pattern nth (form form) :lisp)
2321
2322 (define-caller-pattern first (form) :lisp)
2323 (define-caller-pattern second (form) :lisp)
2324 (define-caller-pattern third (form) :lisp)
2325 (define-caller-pattern fourth (form) :lisp)
2326 (define-caller-pattern fifth (form) :lisp)
2327 (define-caller-pattern sixth (form) :lisp)
2328 (define-caller-pattern seventh (form) :lisp)
2329 (define-caller-pattern eighth (form) :lisp)
2330 (define-caller-pattern ninth (form) :lisp)
2331 (define-caller-pattern tenth (form) :lisp)
2332
2333 (define-caller-pattern rest (form) :lisp)
2334 (define-caller-pattern nthcdr (form form) :lisp)
2335 (define-caller-pattern last (form (:optional form)) :lisp)
2336 (define-caller-pattern list ((:star form)) :lisp)
2337 (define-caller-pattern list* ((:star form)) :lisp)
2338 (define-caller-pattern make-list (form &key (:star form)) :lisp)
2339 (define-caller-pattern append ((:star form)) :lisp)
2340 (define-caller-pattern copy-list (form) :lisp)
2341 (define-caller-pattern copy-alist (form) :lisp)
2342 (define-caller-pattern copy-tree (form) :lisp)
2343 (define-caller-pattern revappend (form form) :lisp)
2344 (define-caller-pattern nconc ((:star form)) :lisp)
2345 (define-caller-pattern nreconc (form form) :lisp)
2346 (define-caller-pattern push (form form) :lisp)
2347 (define-caller-pattern pushnew (form form &key (:star form)) :lisp)
2348 (define-caller-pattern pop (form) :lisp)
2349 (define-caller-pattern butlast (form (:optional form)) :lisp)
2350 (define-caller-pattern nbutlast (form (:optional form)) :lisp)
2351 (define-caller-pattern ldiff (form form) :lisp)
2352 (define-caller-pattern rplaca (form form) :lisp)
2353 (define-caller-pattern rplacd (form form) :lisp)
2354
2355 (define-caller-pattern subst (form form form &key (:star form)) :lisp)
2356 (define-caller-pattern subst-if (form fn form &key (:star form)) :lisp)
2357 (define-caller-pattern subst-if-not (form fn form &key (:star form)) :lisp)
2358 (define-caller-pattern nsubst (form form form &key (:star form)) :lisp)
2359 (define-caller-pattern nsubst-if (form fn form &key (:star form)) :lisp)
2360 (define-caller-pattern nsubst-if-not (form fn form &key (:star form)) :lisp)
2361 (define-caller-pattern sublis (form form &key (:star form)) :lisp)
2362 (define-caller-pattern nsublis (form form &key (:star form)) :lisp)
2363 (define-caller-pattern member (form form &key (:star form)) :lisp)
2364 (define-caller-pattern member-if (fn form &key (:star form)) :lisp)
2365 (define-caller-pattern member-if-not (fn form &key (:star form)) :lisp)
2366
2367 (define-caller-pattern tailp (form form) :lisp)
2368 (define-caller-pattern adjoin (form form &key (:star form)) :lisp)
2369 (define-caller-pattern union (form form &key (:star form)) :lisp)
2370 (define-caller-pattern nunion (form form &key (:star form)) :lisp)
2371 (define-caller-pattern intersection (form form &key (:star form)) :lisp)
2372 (define-caller-pattern nintersection (form form &key (:star form)) :lisp)
2373 (define-caller-pattern set-difference (form form &key (:star form)) :lisp)
2374 (define-caller-pattern nset-difference (form form &key (:star form)) :lisp)
2375 (define-caller-pattern set-exclusive-or (form form &key (:star form)) :lisp)
2376 (define-caller-pattern nset-exclusive-or (form form &key (:star form)) :lisp)
2377 (define-caller-pattern subsetp (form form &key (:star form)) :lisp)
2378
2379 (define-caller-pattern acons (form form form) :lisp)
2380 (define-caller-pattern pairlis (form form (:optional form)) :lisp)
2381 (define-caller-pattern assoc (form form &key (:star form)) :lisp)
2382 (define-caller-pattern assoc-if (fn form) :lisp)
2383 (define-caller-pattern assoc-if-not (fn form) :lisp)
2384 (define-caller-pattern rassoc (form form &key (:star form)) :lisp)
2385 (define-caller-pattern rassoc-if (fn form &key (:star form)) :lisp)
2386 (define-caller-pattern rassoc-if-not (fn form &key (:star form)) :lisp)
2387
2388 ;;; Hash Tables
2389 (define-caller-pattern make-hash-table (&key (:star form)) :lisp)
2390 (define-caller-pattern hash-table-p (form) :lisp)
2391 (define-caller-pattern gethash (form form (:optional form)) :lisp)
2392 (define-caller-pattern remhash (form form) :lisp)
2393 (define-caller-pattern maphash (fn form) :lisp)
2394 (define-caller-pattern clrhash (form) :lisp)
2395 (define-caller-pattern hash-table-count (form) :lisp)
2396 (define-caller-pattern with-hash-table-iterator
2397 ((name form) (:star form)) :lisp2)
2398 (define-caller-pattern hash-table-rehash-size (form) :lisp2)
2399 (define-caller-pattern hash-table-rehash-threshold (form) :lisp2)
2400 (define-caller-pattern hash-table-size (form) :lisp2)
2401 (define-caller-pattern hash-table-test (form) :lisp2)
2402 (define-caller-pattern sxhash (form) :lisp)
2403
2404 ;;; Arrays
2405 (define-caller-pattern make-array (form &key (:star form)) :lisp)
2406 (define-variable-pattern array-rank-limit :lisp)
2407 (define-variable-pattern array-dimension-limit :lisp)
2408 (define-variable-pattern array-total-size-limit :lisp)
2409 (define-caller-pattern vector ((:star form)) :lisp)
2410 (define-caller-pattern aref (form (:star form)) :lisp)
2411 (define-caller-pattern svref (form form) :lisp)
2412 (define-caller-pattern array-element-type (form) :lisp)
2413 (define-caller-pattern array-rank (form) :lisp)
2414 (define-caller-pattern array-dimension (form form) :lisp)
2415 (define-caller-pattern array-dimensions (form) :lisp)
2416 (define-caller-pattern array-total-size (form) :lisp)
2417 (define-caller-pattern array-in-bounds-p (form (:star form)) :lisp)
2418 (define-caller-pattern array-row-major-index (form (:star form)) :lisp)
2419 (define-caller-pattern row-major-aref (form form) :lisp2)
2420 (define-caller-pattern adjustable-array-p (form) :lisp)
2421
2422 (define-caller-pattern bit (form (:star form)) :lisp)
2423 (define-caller-pattern sbit (form (:star form)) :lisp)
2424
2425 (define-caller-pattern bit-and (form form (:optional form)) :lisp)
2426 (define-caller-pattern bit-ior (form form (:optional form)) :lisp)
2427 (define-caller-pattern bit-xor (form form (:optional form)) :lisp)
2428 (define-caller-pattern bit-eqv (form form (:optional form)) :lisp)
2429 (define-caller-pattern bit-nand (form form (:optional form)) :lisp)
2430 (define-caller-pattern bit-nor (form form (:optional form)) :lisp)
2431 (define-caller-pattern bit-andc1 (form form (:optional form)) :lisp)
2432 (define-caller-pattern bit-andc2 (form form (:optional form)) :lisp)
2433 (define-caller-pattern bit-orc1 (form form (:optional form)) :lisp)
2434 (define-caller-pattern bit-orc2 (form form (:optional form)) :lisp)
2435 (define-caller-pattern bit-not (form (:optional form)) :lisp)
2436
2437 (define-caller-pattern array-has-fill-pointer-p (form) :lisp)
2438 (define-caller-pattern fill-pointer (form) :lisp)
2439 (define-caller-pattern vector-push (form form) :lisp)
2440 (define-caller-pattern vector-push-extend (form form (:optional form)) :lisp)
2441 (define-caller-pattern vector-pop (form) :lisp)
2442 (define-caller-pattern adjust-array (form form &key (:star form)) :lisp)
2443
2444 ;;; Strings
2445 (define-caller-pattern char (form form) :lisp)
2446 (define-caller-pattern schar (form form) :lisp)
2447 (define-caller-pattern string= (form form &key (:star form)) :lisp)
2448 (define-caller-pattern string-equal (form form &key (:star form)) :lisp)
2449 (define-caller-pattern string< (form form &key (:star form)) :lisp)
2450 (define-caller-pattern string> (form form &key (:star form)) :lisp)
2451 (define-caller-pattern string<= (form form &key (:star form)) :lisp)
2452 (define-caller-pattern string>= (form form &key (:star form)) :lisp)
2453 (define-caller-pattern string/= (form form &key (:star form)) :lisp)
2454 (define-caller-pattern string-lessp (form form &key (:star form)) :lisp)
2455 (define-caller-pattern string-greaterp (form form &key (:star form)) :lisp)
2456 (define-caller-pattern string-not-greaterp (form form &key (:star form)) :lisp)
2457 (define-caller-pattern string-not-lessp (form form &key (:star form)) :lisp)
2458 (define-caller-pattern string-not-equal (form form &key (:star form)) :lisp)
2459
2460 (define-caller-pattern make-string (form &key (:star form)) :lisp)
2461 (define-caller-pattern string-trim (form form) :lisp)
2462 (define-caller-pattern string-left-trim (form form) :lisp)
2463 (define-caller-pattern string-right-trim (form form) :lisp)
2464 (define-caller-pattern string-upcase (form &key (:star form)) :lisp)
2465 (define-caller-pattern string-downcase (form &key (:star form)) :lisp)
2466 (define-caller-pattern string-capitalize (form &key (:star form)) :lisp)
2467 (define-caller-pattern nstring-upcase (form &key (:star form)) :lisp)
2468 (define-caller-pattern nstring-downcase (form &key (:star form)) :lisp)
2469 (define-caller-pattern nstring-capitalize (form &key (:star form)) :lisp)
2470 (define-caller-pattern string (form) :lisp)
2471
2472 ;;; Structures
2473 (define-caller-pattern defstruct
2474 ((:or name (name (:rest :ignore)))
2475 (:optional documentation-string)
2476 (:plus :ignore))
2477 :lisp)
2478
2479 ;;; The Evaluator
2480 (define-caller-pattern eval (form) :lisp)
2481 (define-variable-pattern *evalhook* :lisp)
2482 (define-variable-pattern *applyhook* :lisp)
2483 (define-caller-pattern evalhook (form fn fn &optional :ignore) :lisp)
2484 (define-caller-pattern applyhook (fn form fn fn &optional :ignore) :lisp)
2485 (define-caller-pattern constantp (form) :lisp)
2486
2487 ;;; Streams
2488 (define-variable-pattern *standard-input* :lisp)
2489 (define-variable-pattern *standard-output* :lisp)
2490 (define-variable-pattern *error-output* :lisp)
2491 (define-variable-pattern *query-io* :lisp)
2492 (define-variable-pattern *debug-io* :lisp)
2493 (define-variable-pattern *terminal-io* :lisp)
2494 (define-variable-pattern *trace-output* :lisp)
2495 (define-caller-pattern make-synonym-stream (symbol) :lisp)
2496 (define-caller-pattern make-broadcast-stream ((:star form)) :lisp)
2497 (define-caller-pattern make-concatenated-stream ((:star form)) :lisp)
2498 (define-caller-pattern make-two-way-stream (form form) :lisp)
2499 (define-caller-pattern make-echo-stream (form form) :lisp)
2500 (define-caller-pattern make-string-input-stream (form &optional form form) :lisp)
2501 (define-caller-pattern make-string-output-stream (&key (:star form)) :lisp)
2502 (define-caller-pattern get-output-stream-string (form) :lisp)
2503
2504 (define-caller-pattern with-open-stream
2505 ((var form)
2506 (:star declaration)
2507 (:star form))
2508 :lisp)
2509
2510 (define-caller-pattern with-input-from-string
2511 ((var form &key (:star form))
2512 (:star declaration)
2513 (:star form))
2514 :lisp)
2515
2516 (define-caller-pattern with-output-to-string
2517 ((var (:optional form))
2518 (:star declaration)
2519 (:star form))
2520 :lisp)
2521 (define-caller-pattern streamp (form) :lisp)
2522 (define-caller-pattern open-stream-p (form) :lisp2)
2523 (define-caller-pattern input-stream-p (form) :lisp)
2524 (define-caller-pattern output-stream-p (form) :lisp)
2525 (define-caller-pattern stream-element-type (form) :lisp)
2526 (define-caller-pattern close (form (:rest :ignore)) :lisp)
2527 (define-caller-pattern broadcast-stream-streams (form) :lisp2)
2528 (define-caller-pattern concatenated-stream-streams (form) :lisp2)
2529 (define-caller-pattern echo-stream-input-stream (form) :lisp2)
2530 (define-caller-pattern echo-stream-output-stream (form) :lisp2)
2531 (define-caller-pattern synonym-stream-symbol (form) :lisp2)
2532 (define-caller-pattern two-way-stream-input-stream (form) :lisp2)
2533 (define-caller-pattern two-way-stream-output-stream (form) :lisp2)
2534 (define-caller-pattern interactive-stream-p (form) :lisp2)
2535 (define-caller-pattern stream-external-format (form) :lisp2)
2536
2537 ;;; Reader
2538 (define-variable-pattern *read-base* :lisp)
2539 (define-variable-pattern *read-suppress* :lisp)
2540 (define-variable-pattern *read-eval* :lisp2)
2541 (define-variable-pattern *readtable* :lisp)
2542 (define-caller-pattern copy-readtable (&optional form form) :lisp)
2543 (define-caller-pattern readtablep (form) :lisp)
2544 (define-caller-pattern set-syntax-from-char (form form &optional form form) :lisp)
2545 (define-caller-pattern set-macro-character (form fn &optional form) :lisp)
2546 (define-caller-pattern get-macro-character (form (:optional form)) :lisp)
2547 (define-caller-pattern make-dispatch-macro-character (form &optional form form)
2548 :lisp)
2549 (define-caller-pattern set-dispatch-macro-character
2550 (form form fn (:optional form)) :lisp)
2551 (define-caller-pattern get-dispatch-macro-character
2552 (form form (:optional form)) :lisp)
2553 (define-caller-pattern readtable-case (form) :lisp2)
2554 (define-variable-pattern *print-readably* :lisp2)
2555 (define-variable-pattern *print-escape* :lisp)
2556 (define-variable-pattern *print-pretty* :lisp)
2557 (define-variable-pattern *print-circle* :lisp)
2558 (define-variable-pattern *print-base* :lisp)
2559 (define-variable-pattern *print-radix* :lisp)
2560 (define-variable-pattern *print-case* :lisp)
2561 (define-variable-pattern *print-gensym* :lisp)
2562 (define-variable-pattern *print-level* :lisp)
2563 (define-variable-pattern *print-length* :lisp)
2564 (define-variable-pattern *print-array* :lisp)
2565 (define-caller-pattern with-standard-io-syntax
2566 ((:star declaration)
2567 (:star form))
2568 :lisp2)
2569
2570 (define-caller-pattern read (&optional form form form form) :lisp)
2571 (define-variable-pattern *read-default-float-format* :lisp)
2572 (define-caller-pattern read-preserving-whitespace
2573 (&optional form form form form) :lisp)
2574 (define-caller-pattern read-delimited-list (form &optional form form) :lisp)
2575 (define-caller-pattern read-line (&optional form form form form) :lisp)
2576 (define-caller-pattern read-char (&optional form form form form) :lisp)
2577 (define-caller-pattern unread-char (form (:optional form)) :lisp)
2578 (define-caller-pattern peek-char (&optional form form form form) :lisp)
2579 (define-caller-pattern listen ((:optional form)) :lisp)
2580 (define-caller-pattern read-char-no-hang ((:star form)) :lisp)
2581 (define-caller-pattern clear-input ((:optional form)) :lisp)
2582 (define-caller-pattern read-from-string (form (:star form)) :lisp)
2583 (define-caller-pattern parse-integer (form &rest :ignore) :lisp)
2584 (define-caller-pattern read-byte ((:star form)) :lisp)
2585
2586 (define-caller-pattern write (form &key (:star form)) :lisp)
2587 (define-caller-pattern prin1 (form (:optional form)) :lisp)
2588 (define-caller-pattern print (form (:optional form)) :lisp)
2589 (define-caller-pattern pprint (form (:optional form)) :lisp)
2590 (define-caller-pattern princ (form (:optional form)) :lisp)
2591 (define-caller-pattern write-to-string (form &key (:star form)) :lisp)
2592 (define-caller-pattern prin1-to-string (form) :lisp)
2593 (define-caller-pattern princ-to-string (form) :lisp)
2594 (define-caller-pattern write-char (form (:optional form)) :lisp)
2595 (define-caller-pattern write-string (form &optional form &key (:star form)) :lisp)
2596 (define-caller-pattern write-line (form &optional form &key (:star form)) :lisp)
2597 (define-caller-pattern terpri ((:optional form)) :lisp)
2598 (define-caller-pattern fresh-line ((:optional form)) :lisp)
2599 (define-caller-pattern finish-output ((:optional form)) :lisp)
2600 (define-caller-pattern force-output ((:optional form)) :lisp)
2601 (define-caller-pattern clear-output ((:optional form)) :lisp)
2602 (define-caller-pattern print-unreadable-object
2603 ((form form &key (:star form))
2604 (:star declaration)
2605 (:star form))
2606 :lisp2)
2607 (define-caller-pattern write-byte (form form) :lisp)
2608 (define-caller-pattern format
2609 (destination
2610 control-string
2611 (:rest format-arguments))
2612 :lisp)
2613
2614 (define-caller-pattern y-or-n-p (control-string (:star form)) :lisp)
2615 (define-caller-pattern yes-or-no-p (control-string (:star form)) :lisp)
2616
2617 ;;; Pathnames
2618 (define-caller-pattern wild-pathname-p (form &optional form) :lisp2)
2619 (define-caller-pattern pathname-match-p (form form) :lisp2)
2620 (define-caller-pattern translate-pathname (form form form &key (:star form))
2621 :lisp2)
2622
2623 (define-caller-pattern logical-pathname (form) :lisp2)
2624 (define-caller-pattern translate-logical-pathname (form &key (:star form)) :lisp2)
2625 (define-caller-pattern logical-pathname-translations (form) :lisp2)
2626 (define-caller-pattern load-logical-pathname-translations (form) :lisp2)
2627 (define-caller-pattern compile-file-pathname (form &key form) :lisp2)
2628
2629 (define-caller-pattern pathname (form) :lisp)
2630 (define-caller-pattern truename (form) :lisp)
2631 (define-caller-pattern parse-namestring ((:star form)) :lisp)
2632 (define-caller-pattern merge-pathnames ((:star form)) :lisp)
2633 (define-variable-pattern *default-pathname-defaults* :lisp)
2634 (define-caller-pattern make-pathname ((:star form)) :lisp)
2635 (define-caller-pattern pathnamep (form) :lisp)
2636 (define-caller-pattern pathname-host (form) :lisp)
2637 (define-caller-pattern pathname-device (form) :lisp)
2638 (define-caller-pattern pathname-directory (form) :lisp)
2639 (define-caller-pattern pathname-name (form) :lisp)
2640 (define-caller-pattern pathname-type (form) :lisp)
2641 (define-caller-pattern pathname-version (form) :lisp)
2642 (define-caller-pattern namestring (form) :lisp)
2643 (define-caller-pattern file-namestring (form) :lisp)
2644 (define-caller-pattern directory-namestring (form) :lisp)
2645 (define-caller-pattern host-namestring (form) :lisp)
2646 (define-caller-pattern enough-namestring (form (:optional form)) :lisp)
2647 (define-caller-pattern user-homedir-pathname (&optional form) :lisp)
2648 (define-caller-pattern open (form &key (:star form)) :lisp)
2649 (define-caller-pattern with-open-file
2650 ((var form (:rest :ignore))
2651 (:star declaration)
2652 (:star form))
2653 :lisp)
2654
2655 (define-caller-pattern rename-file (form form) :lisp)
2656 (define-caller-pattern delete-file (form) :lisp)
2657 (define-caller-pattern probe-file (form) :lisp)
2658 (define-caller-pattern file-write-date (form) :lisp)
2659 (define-caller-pattern file-author (form) :lisp)
2660 (define-caller-pattern file-position (form