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
|
|
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
|