Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

2906 lines
124 KiB

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