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