Mercurial > emacs
comparison lisp/cedet/semantic/analyze/fcn.el @ 104421:b66bb908c129
cedet/semantic/debug.el,
cedet/semantic/doc.el,
cedet/semantic/tag-write.el,
cedet/semantic/analyze/complete.el,
cedet/semantic/analyze/debug.el,
cedet/semantic/analyze/fcn.el,
cedet/semantic/analyze/refs.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 29 Aug 2009 19:45:47 +0000 |
parents | |
children | 2bf481006ba4 |
comparison
equal
deleted
inserted
replaced
104420:2e15afd37998 | 104421:b66bb908c129 |
---|---|
1 ;;; semantic/analyze/fcn.el --- Analyzer support functions. | |
2 | |
3 ;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation, either version 3 of the License, or | |
12 ;; (at your option) any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | |
22 ;;; Commentary: | |
23 ;; | |
24 ;; Analyzer support functions. | |
25 | |
26 ;;; Code: | |
27 | |
28 ;;; Small Mode Specific Options | |
29 ;; | |
30 ;; These queries allow a major mode to help the analyzer make decisions. | |
31 ;; | |
32 (define-overloadable-function semantic-analyze-tag-prototype-p (tag) | |
33 "Non-nil if TAG is a prototype." | |
34 ) | |
35 | |
36 (defun semantic-analyze-tag-prototype-p-default (tag) | |
37 "Non-nil if TAG is a prototype." | |
38 (let ((p (semantic-tag-get-attribute tag :prototype-flag))) | |
39 (cond | |
40 ;; Trust the parser author. | |
41 (p p) | |
42 ;; Empty types might be a prototype. | |
43 ((eq (semantic-tag-class tag) 'type) | |
44 (not (semantic-tag-type-members tag))) | |
45 ;; No other heuristics. | |
46 (t nil)) | |
47 )) | |
48 | |
49 ;;------------------------------------------------------------ | |
50 | |
51 (define-overloadable-function semantic-analyze-split-name (name) | |
52 "Split a tag NAME into a sequence. | |
53 Sometimes NAMES are gathered from the parser that are compounded, | |
54 such as in C++ where foo::bar means: | |
55 \"The class BAR in the namespace FOO.\" | |
56 Return the string NAME for no change, or a list if it needs to be split.") | |
57 | |
58 (defun semantic-analyze-split-name-default (name) | |
59 "Don't split up NAME by default." | |
60 name) | |
61 | |
62 (define-overloadable-function semantic-analyze-unsplit-name (namelist) | |
63 "Assemble a NAMELIST into a string representing a compound name. | |
64 Return the string representing the compound name.") | |
65 | |
66 (defun semantic-analyze-unsplit-name-default (namelist) | |
67 "Concatenate the names in NAMELIST with a . between." | |
68 (mapconcat 'identity namelist ".")) | |
69 | |
70 ;;; SELECTING | |
71 ;; | |
72 ;; If you narrow things down to a list of tags that all mean | |
73 ;; the same thing, how to you pick one? Select or merge. | |
74 ;; | |
75 | |
76 (defun semantic-analyze-select-best-tag (sequence &optional tagclass) | |
77 "For a SEQUENCE of tags, all with good names, pick the best one. | |
78 If SEQUENCE is made up of namespaces, merge the namespaces together. | |
79 If SEQUENCE has several prototypes, find the non-prototype. | |
80 If SEQUENCE has some items w/ no type information, find the one with a type. | |
81 If SEQUENCE is all prototypes, or has no prototypes, get the first one. | |
82 Optional TAGCLASS indicates to restrict the return to only | |
83 tags of TAGCLASS." | |
84 | |
85 ;; If there is a srew up and we get just one tag.. massage over it. | |
86 (when (semantic-tag-p sequence) | |
87 (setq sequence (list sequence))) | |
88 | |
89 ;; Filter out anything not of TAGCLASS | |
90 (when tagclass | |
91 (setq sequence (semantic-find-tags-by-class tagclass sequence))) | |
92 | |
93 (if (< (length sequence) 2) | |
94 ;; If the remaining sequence is 1 tag or less, just return it | |
95 ;; and skip the rest of this mumbo-jumbo. | |
96 (car sequence) | |
97 | |
98 ;; 1) | |
99 ;; This step will eliminate a vast majority of the types, | |
100 ;; in addition to merging namespaces together. | |
101 ;; | |
102 ;; 2) | |
103 ;; It will also remove prototypes. | |
104 (setq sequence (semanticdb-typecache-merge-streams sequence nil)) | |
105 | |
106 (if (< (length sequence) 2) | |
107 ;; If the remaining sequence after the merge is 1 tag or less, | |
108 ;; just return it and skip the rest of this mumbo-jumbo. | |
109 (car sequence) | |
110 | |
111 (let ((best nil) | |
112 (notypeinfo nil) | |
113 ) | |
114 (while (and (not best) sequence) | |
115 | |
116 ;; 3) select a non-prototype. | |
117 (if (not (semantic-tag-type (car sequence))) | |
118 (setq notypeinfo (car sequence)) | |
119 | |
120 (setq best (car sequence)) | |
121 ) | |
122 | |
123 (setq sequence (cdr sequence))) | |
124 | |
125 ;; Select the best, or at least the prototype. | |
126 (or best notypeinfo))))) | |
127 | |
128 ;;; Tag Finding | |
129 ;; | |
130 ;; Mechanism for lookup up tags by name. | |
131 ;; | |
132 (defun semantic-analyze-find-tags-by-prefix (prefix) | |
133 ;; @todo - only used in semantic-complete. Find something better? | |
134 "Attempt to find a tag with PREFIX. | |
135 This is a wrapper on top of semanticdb, and semantic search functions. | |
136 Almost all searches use the same arguments." | |
137 (if (and (fboundp 'semanticdb-minor-mode-p) | |
138 (semanticdb-minor-mode-p)) | |
139 ;; Search the database & concatenate all matches together. | |
140 (semanticdb-strip-find-results | |
141 (semanticdb-find-tags-for-completion prefix) | |
142 'name) | |
143 ;; Search just this file because there is no DB available. | |
144 (semantic-find-tags-for-completion | |
145 prefix (current-buffer)))) | |
146 | |
147 ;;; Finding Datatypes | |
148 ;; | |
149 ;; Finding a data type by name within a project. | |
150 ;; | |
151 (defun semantic-analyze-type-to-name (type) | |
152 "Get the name of TAG's type. | |
153 The TYPE field in a tag can be nil (return nil) | |
154 or a string, or a non-positional tag." | |
155 (cond ((semantic-tag-p type) | |
156 (semantic-tag-name type)) | |
157 ((stringp type) | |
158 type) | |
159 ((listp type) | |
160 (car type)) | |
161 (t nil))) | |
162 | |
163 (defun semantic-analyze-tag-type (tag &optional scope nometaderef) | |
164 "Return the semantic tag for a type within the type of TAG. | |
165 TAG can be a variable, function or other type of tag. | |
166 The behavior of TAG's type is defined by `semantic-analyze-type'. | |
167 Optional SCOPE represents a calculated scope in which the | |
168 types might be found. This can be nil. | |
169 If NOMETADEREF, then do not dereference metatypes. This is | |
170 used by the analyzer debugger." | |
171 (semantic-analyze-type (semantic-tag-type tag) scope nometaderef)) | |
172 | |
173 (defun semantic-analyze-type (type-declaration &optional scope nometaderef) | |
174 "Return the semantic tag for TYPE-DECLARATION. | |
175 TAG can be a variable, function or other type of tag. | |
176 The type of tag (such as a class or struct) is a name. | |
177 Lookup this name in database, and return all slots/fields | |
178 within that types field. Also handles anonymous types. | |
179 Optional SCOPE represents a calculated scope in which the | |
180 types might be found. This can be nil. | |
181 If NOMETADEREF, then do not dereference metatypes. This is | |
182 used by the analyzer debugger." | |
183 (let ((name nil) | |
184 (typetag nil) | |
185 ) | |
186 | |
187 ;; Is it an anonymous type? | |
188 (if (and type-declaration | |
189 (semantic-tag-p type-declaration) | |
190 (semantic-tag-of-class-p type-declaration 'type) | |
191 (not (semantic-analyze-tag-prototype-p type-declaration)) | |
192 ) | |
193 ;; We have an anonymous type for TAG with children. | |
194 ;; Use this type directly. | |
195 (if nometaderef | |
196 type-declaration | |
197 (semantic-analyze-dereference-metatype-stack | |
198 type-declaration scope type-declaration)) | |
199 | |
200 ;; Not an anonymous type. Look up the name of this type | |
201 ;; elsewhere, and report back. | |
202 (setq name (semantic-analyze-type-to-name type-declaration)) | |
203 | |
204 (if (and name (not (string= name ""))) | |
205 (progn | |
206 ;; Find a type of that name in scope. | |
207 (setq typetag (and scope (semantic-scope-find name 'type scope))) | |
208 ;; If no typetag, try the typecache | |
209 (when (not typetag) | |
210 (setq typetag (semanticdb-typecache-find name)))) | |
211 | |
212 ;; No name to look stuff up with. | |
213 (error "Semantic tag %S has no type information" | |
214 (semantic-tag-name type-declaration))) | |
215 | |
216 ;; Handle lists of tags. | |
217 (when (and (consp typetag) (semantic-tag-p (car typetag))) | |
218 (setq typetag (semantic-analyze-select-best-tag typetag 'type)) | |
219 ) | |
220 | |
221 ;; We now have a tag associated with the type. We need to deref it. | |
222 ;; | |
223 ;; If we were asked not to (ie - debugger) push the typecache anyway. | |
224 (if nometaderef | |
225 typetag | |
226 (unwind-protect | |
227 (progn | |
228 (semantic-scope-set-typecache | |
229 scope (semantic-scope-tag-get-scope typetag)) | |
230 (semantic-analyze-dereference-metatype-stack typetag scope type-declaration) | |
231 ) | |
232 (semantic-scope-set-typecache scope nil) | |
233 ))))) | |
234 | |
235 (defun semantic-analyze-dereference-metatype-stack (type scope &optional type-declaration) | |
236 "Dereference metatypes repeatedly until we hit a real TYPE. | |
237 Uses `semantic-analyze-dereference-metatype'. | |
238 Argument SCOPE is the scope object with additional items in which to search. | |
239 Optional argument TYPE-DECLARATION is how TYPE was found referenced." | |
240 (let ((lasttype type) | |
241 (lasttypedeclaration type-declaration) | |
242 (nexttype (semantic-analyze-dereference-metatype type scope type-declaration)) | |
243 (idx 0)) | |
244 (catch 'metatype-recursion | |
245 (while (and nexttype (not (eq (car nexttype) lasttype))) | |
246 (setq lasttype (car nexttype) | |
247 lasttypedeclaration (cadr nexttype)) | |
248 (setq nexttype (semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration)) | |
249 (setq idx (1+ idx)) | |
250 (when (> idx 20) (message "Possible metatype recursion for %S" | |
251 (semantic-tag-name lasttype)) | |
252 (throw 'metatype-recursion nil)) | |
253 )) | |
254 lasttype)) | |
255 | |
256 (define-overloadable-function semantic-analyze-dereference-metatype (type scope &optional type-declaration) | |
257 ;; todo - move into typecahe!! | |
258 "Return a concrete type tag based on input TYPE tag. | |
259 A concrete type is an actual declaration of a memory description, | |
260 such as a structure, or class. A meta type is an alias, | |
261 or a typedef in C or C++. If TYPE is concrete, it | |
262 is returned. If it is a meta type, it will return the concrete | |
263 type defined by TYPE. | |
264 The default behavior always returns TYPE. | |
265 Override functions need not return a real semantic tag. | |
266 Just a name, or short tag will be ok. It will be expanded here. | |
267 SCOPE is the scope object with additional items in which to search for names." | |
268 (catch 'default-behavior | |
269 (let* ((ans-tuple (:override | |
270 ;; Nothing fancy, just return type by default. | |
271 (throw 'default-behavior (list type type-declaration)))) | |
272 (ans-type (car ans-tuple)) | |
273 (ans-type-declaration (cadr ans-tuple))) | |
274 (list (semantic-analyze-dereference-metatype-1 ans-type scope) ans-type-declaration)))) | |
275 | |
276 ;; @ TODO - the typecache can also return a stack of scope names. | |
277 | |
278 (defun semantic-analyze-dereference-metatype-1 (ans scope) | |
279 "Do extra work after dereferencing a metatype. | |
280 ANS is the answer from the the language specific query. | |
281 SCOPE is the current scope." | |
282 ;; If ANS is a string, or if ANS is a short tag, we | |
283 ;; need to do some more work to look it up. | |
284 (if (stringp ans) | |
285 ;; The metatype is just a string... look it up. | |
286 (or (and scope (car-safe | |
287 ;; @todo - should this be `find the best one'? | |
288 (semantic-scope-find ans 'type scope))) | |
289 (let ((tcsans nil)) | |
290 (prog1 | |
291 (setq tcsans | |
292 (semanticdb-typecache-find ans)) | |
293 ;; While going through the metatype, if we have | |
294 ;; a scope, push our new cache in. | |
295 (when scope | |
296 (semantic-scope-set-typecache | |
297 scope (semantic-scope-tag-get-scope tcsans)) | |
298 )) | |
299 )) | |
300 (when (and (semantic-tag-p ans) | |
301 (eq (semantic-tag-class ans) 'type)) | |
302 ;; We have a tag. | |
303 (if (semantic-analyze-tag-prototype-p ans) | |
304 ;; It is a prototype.. find the real one. | |
305 (or (and scope | |
306 (car-safe | |
307 (semantic-scope-find (semantic-tag-name ans) | |
308 'type scope))) | |
309 (let ((tcsans nil)) | |
310 (prog1 | |
311 (setq tcsans | |
312 (semanticdb-typecache-find (semantic-tag-name ans))) | |
313 ;; While going through the metatype, if we have | |
314 ;; a scope, push our new cache in. | |
315 (when scope | |
316 (semantic-scope-set-typecache | |
317 scope (semantic-scope-tag-get-scope tcsans)) | |
318 )))) | |
319 ;; We have a tag, and it is not a prototype. | |
320 ans)) | |
321 )) | |
322 | |
323 (provide 'semantic/analyze/fcn) | |
324 | |
325 ;;; semantic/analyze/fcn.el ends here |