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