1 ;;; semantic/analyze/fcn.el --- Analyzer support functions.
3 ;; Copyright (C) 2007-2018 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; This file is part of GNU Emacs.
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.
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.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
24 ;; Analyzer support functions.
29 (eval-when-compile (require 'semantic
/find
))
31 (declare-function semanticdb-typecache-merge-streams
"semantic/db-typecache")
32 (declare-function semantic-scope-find
"semantic/scope")
33 (declare-function semantic-scope-set-typecache
"semantic/scope")
34 (declare-function semantic-scope-tag-get-scope
"semantic/scope")
36 ;;; Small Mode Specific Options
38 ;; These queries allow a major mode to help the analyzer make decisions.
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.")
48 (defun semantic-analyze-split-name-default (name)
49 "Don't split up NAME by default."
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.")
56 (defun semantic-analyze-unsplit-name-default (namelist)
57 "Concatenate the names in NAMELIST with a . between."
58 (mapconcat 'identity namelist
"."))
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.
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
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
)))
79 ;; Filter out anything not of TAGCLASS
81 (setq sequence
(semantic-find-tags-by-class tagclass sequence
)))
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.
89 ;; This step will eliminate a vast majority of the types,
90 ;; in addition to merging namespaces together.
93 ;; It will also remove prototypes.
94 (require 'semantic
/db-typecache
)
95 (setq sequence
(semanticdb-typecache-merge-streams sequence nil
))
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.
105 (while (and (not best
) sequence
)
107 ;; 3) select a non-prototype.
108 (if (not (semantic-tag-type (car sequence
)))
109 (setq notypeinfo
(car sequence
))
111 (setq best
(car sequence
))
114 (setq sequence
(cdr sequence
)))
116 ;; Select the best, or at least the prototype.
117 (or best notypeinfo
)))))
121 ;; Mechanism for lookup up tags by name.
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
)
134 ;; Search just this file because there is no DB available.
135 (semantic-find-tags-for-completion
136 prefix
(current-buffer))))
138 ;;; Finding Datatypes
141 (define-overloadable-function semantic-analyze-dereference-metatype
(type scope
&optional type-declaration
)
142 ;; todo - move into typecache!!
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
))))
161 ;; Finding a data type by name within a project.
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
)
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
)))
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
))
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."
198 (require 'semantic
/scope
)
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
)
207 (not (semantic-tag-prototype-p type-declaration
))
209 ;; We have an anonymous type for TAG with children.
210 ;; Use this type directly.
213 (semantic-analyze-dereference-metatype-stack
214 type-declaration scope type-declaration
))
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
))
220 (if (and name
(not (string= name
"")))
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
226 (setq typetag
(semanticdb-typecache-find name
))))
228 ;; No name to look stuff up with.
229 (error "Semantic tag %S has no type information"
230 (semantic-tag-name type-declaration
)))
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
))
237 ;; We now have a tag associated with the type. We need to deref it.
239 ;; If we were asked not to (ie - debugger) push the typecache anyway.
244 (semantic-scope-set-typecache
245 scope
(semantic-scope-tag-get-scope typetag
))
246 (semantic-analyze-dereference-metatype-stack typetag scope type-declaration
)
248 (semantic-scope-set-typecache scope nil
)
251 (autoload 'semantic-tag-similar-p
"semantic/tag-ls")
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
))
262 (catch 'metatype-recursion
263 (while (and nexttype
(not (semantic-tag-similar-p (car nexttype
) lasttype
)))
264 (setq lasttype
(car nexttype
)
265 lasttypedeclaration
(cadr nexttype
))
266 (setq nexttype
(semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration
))
268 (when (> idx
20) (message "Possible metatype recursion for %S"
269 (semantic-tag-name lasttype
))
270 (throw 'metatype-recursion nil
))
274 ;; @ TODO - the typecache can also return a stack of scope names.
276 (defun semantic-analyze-dereference-metatype-1 (ans scope
)
277 "Do extra work after dereferencing a metatype.
278 ANS is the answer from the language specific query.
279 SCOPE is the current scope."
280 (require 'semantic
/scope
)
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.
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
)))
291 (semanticdb-typecache-find ans
))
292 ;; While going through the metatype, if we have
293 ;; a scope, push our new cache in.
295 (semantic-scope-set-typecache
296 scope
(semantic-scope-tag-get-scope tcsans
))
299 (when (and (semantic-tag-p ans
)
300 (eq (semantic-tag-class ans
) 'type
))
302 (if (semantic-tag-prototype-p ans
)
303 ;; It is a prototype.. find the real one.
306 (semantic-scope-find (semantic-tag-name ans
)
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.
315 (semantic-scope-set-typecache
316 scope
(semantic-scope-tag-get-scope tcsans
))
318 ;; We have a tag, and it is not a prototype.
322 (provide 'semantic
/analyze
/fcn
)
324 ;;; semantic/analyze/fcn.el ends here