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