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