Mercurial > emacs
view lisp/cedet/semantic/analyze/fcn.el @ 105260:bbd7017a25d9
CEDET (development tools) package merged.
* cedet/*.el:
* cedet/ede/*.el:
* cedet/semantic/*.el:
* cedet/srecode/*.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 28 Sep 2009 15:15:00 +0000 |
parents | 7811201f57f2 |
children | 2cbef47a062b |
line wrap: on
line source
;;; semantic/analyze/fcn.el --- Analyzer support functions. ;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; ;; Analyzer support functions. ;;; Code: (require 'semantic) (eval-when-compile (require 'semantic/find)) (declare-function semanticdb-typecache-merge-streams "semantic/db-typecache") (declare-function semantic-scope-find name "semantic/scope") (declare-function semantic-scope-set-typecache "semantic/scope") (declare-function semantic-scope-tag-get-scope "semantic/scope") ;;; Small Mode Specific Options ;; ;; These queries allow a major mode to help the analyzer make decisions. ;; (define-overloadable-function semantic-analyze-tag-prototype-p (tag) "Non-nil if TAG is a prototype." ) (defun semantic-analyze-tag-prototype-p-default (tag) "Non-nil if TAG is a prototype." (let ((p (semantic-tag-get-attribute tag :prototype-flag))) (cond ;; Trust the parser author. (p p) ;; Empty types might be a prototype. ((eq (semantic-tag-class tag) 'type) (not (semantic-tag-type-members tag))) ;; No other heuristics. (t nil)) )) ;;------------------------------------------------------------ (define-overloadable-function semantic-analyze-split-name (name) "Split a tag NAME into a sequence. Sometimes NAMES are gathered from the parser that are compounded, such as in C++ where foo::bar means: \"The class BAR in the namespace FOO.\" Return the string NAME for no change, or a list if it needs to be split.") (defun semantic-analyze-split-name-default (name) "Don't split up NAME by default." name) (define-overloadable-function semantic-analyze-unsplit-name (namelist) "Assemble a NAMELIST into a string representing a compound name. Return the string representing the compound name.") (defun semantic-analyze-unsplit-name-default (namelist) "Concatenate the names in NAMELIST with a . between." (mapconcat 'identity namelist ".")) ;;; SELECTING ;; ;; If you narrow things down to a list of tags that all mean ;; the same thing, how to you pick one? Select or merge. ;; (defun semantic-analyze-select-best-tag (sequence &optional tagclass) "For a SEQUENCE of tags, all with good names, pick the best one. If SEQUENCE is made up of namespaces, merge the namespaces together. If SEQUENCE has several prototypes, find the non-prototype. If SEQUENCE has some items w/ no type information, find the one with a type. If SEQUENCE is all prototypes, or has no prototypes, get the first one. Optional TAGCLASS indicates to restrict the return to only tags of TAGCLASS." ;; If there is a srew up and we get just one tag.. massage over it. (when (semantic-tag-p sequence) (setq sequence (list sequence))) ;; Filter out anything not of TAGCLASS (when tagclass (setq sequence (semantic-find-tags-by-class tagclass sequence))) (if (< (length sequence) 2) ;; If the remaining sequence is 1 tag or less, just return it ;; and skip the rest of this mumbo-jumbo. (car sequence) ;; 1) ;; This step will eliminate a vast majority of the types, ;; in addition to merging namespaces together. ;; ;; 2) ;; It will also remove prototypes. (require 'semantic/db-typecache) (setq sequence (semanticdb-typecache-merge-streams sequence nil)) (if (< (length sequence) 2) ;; If the remaining sequence after the merge is 1 tag or less, ;; just return it and skip the rest of this mumbo-jumbo. (car sequence) (let ((best nil) (notypeinfo nil) ) (while (and (not best) sequence) ;; 3) select a non-prototype. (if (not (semantic-tag-type (car sequence))) (setq notypeinfo (car sequence)) (setq best (car sequence)) ) (setq sequence (cdr sequence))) ;; Select the best, or at least the prototype. (or best notypeinfo))))) ;;; Tag Finding ;; ;; Mechanism for lookup up tags by name. ;; (defun semantic-analyze-find-tags-by-prefix (prefix) ;; @todo - only used in semantic-complete. Find something better? "Attempt to find a tag with PREFIX. This is a wrapper on top of semanticdb, and semantic search functions. Almost all searches use the same arguments." (if (and (fboundp 'semanticdb-minor-mode-p) (semanticdb-minor-mode-p)) ;; Search the database & concatenate all matches together. (semanticdb-strip-find-results (semanticdb-find-tags-for-completion prefix) 'name) ;; Search just this file because there is no DB available. (semantic-find-tags-for-completion prefix (current-buffer)))) ;;; Finding Datatypes ;; (define-overloadable-function semantic-analyze-dereference-metatype (type scope &optional type-declaration) ;; todo - move into typecahe!! "Return a concrete type tag based on input TYPE tag. A concrete type is an actual declaration of a memory description, such as a structure, or class. A meta type is an alias, or a typedef in C or C++. If TYPE is concrete, it is returned. If it is a meta type, it will return the concrete type defined by TYPE. The default behavior always returns TYPE. Override functions need not return a real semantic tag. Just a name, or short tag will be ok. It will be expanded here. SCOPE is the scope object with additional items in which to search for names." (catch 'default-behavior (let* ((ans-tuple (:override ;; Nothing fancy, just return type by default. (throw 'default-behavior (list type type-declaration)))) (ans-type (car ans-tuple)) (ans-type-declaration (cadr ans-tuple))) (list (semantic-analyze-dereference-metatype-1 ans-type scope) ans-type-declaration)))) ;; Finding a data type by name within a project. ;; (defun semantic-analyze-type-to-name (type) "Get the name of TAG's type. The TYPE field in a tag can be nil (return nil) or a string, or a non-positional tag." (cond ((semantic-tag-p type) (semantic-tag-name type)) ((stringp type) type) ((listp type) (car type)) (t nil))) (defun semantic-analyze-tag-type (tag &optional scope nometaderef) "Return the semantic tag for a type within the type of TAG. TAG can be a variable, function or other type of tag. The behavior of TAG's type is defined by `semantic-analyze-type'. Optional SCOPE represents a calculated scope in which the types might be found. This can be nil. If NOMETADEREF, then do not dereference metatypes. This is used by the analyzer debugger." (semantic-analyze-type (semantic-tag-type tag) scope nometaderef)) (defun semantic-analyze-type (type-declaration &optional scope nometaderef) "Return the semantic tag for TYPE-DECLARATION. TAG can be a variable, function or other type of tag. The type of tag (such as a class or struct) is a name. Lookup this name in database, and return all slots/fields within that types field. Also handles anonymous types. Optional SCOPE represents a calculated scope in which the types might be found. This can be nil. If NOMETADEREF, then do not dereference metatypes. This is used by the analyzer debugger." (require 'semantic/scope) (let ((name nil) (typetag nil) ) ;; Is it an anonymous type? (if (and type-declaration (semantic-tag-p type-declaration) (semantic-tag-of-class-p type-declaration 'type) (not (semantic-analyze-tag-prototype-p type-declaration)) ) ;; We have an anonymous type for TAG with children. ;; Use this type directly. (if nometaderef type-declaration (semantic-analyze-dereference-metatype-stack type-declaration scope type-declaration)) ;; Not an anonymous type. Look up the name of this type ;; elsewhere, and report back. (setq name (semantic-analyze-type-to-name type-declaration)) (if (and name (not (string= name ""))) (progn ;; Find a type of that name in scope. (setq typetag (and scope (semantic-scope-find name 'type scope))) ;; If no typetag, try the typecache (when (not typetag) (setq typetag (semanticdb-typecache-find name)))) ;; No name to look stuff up with. (error "Semantic tag %S has no type information" (semantic-tag-name type-declaration))) ;; Handle lists of tags. (when (and (consp typetag) (semantic-tag-p (car typetag))) (setq typetag (semantic-analyze-select-best-tag typetag 'type)) ) ;; We now have a tag associated with the type. We need to deref it. ;; ;; If we were asked not to (ie - debugger) push the typecache anyway. (if nometaderef typetag (unwind-protect (progn (semantic-scope-set-typecache scope (semantic-scope-tag-get-scope typetag)) (semantic-analyze-dereference-metatype-stack typetag scope type-declaration) ) (semantic-scope-set-typecache scope nil) ))))) (defun semantic-analyze-dereference-metatype-stack (type scope &optional type-declaration) "Dereference metatypes repeatedly until we hit a real TYPE. Uses `semantic-analyze-dereference-metatype'. Argument SCOPE is the scope object with additional items in which to search. Optional argument TYPE-DECLARATION is how TYPE was found referenced." (let ((lasttype type) (lasttypedeclaration type-declaration) (nexttype (semantic-analyze-dereference-metatype type scope type-declaration)) (idx 0)) (catch 'metatype-recursion (while (and nexttype (not (eq (car nexttype) lasttype))) (setq lasttype (car nexttype) lasttypedeclaration (cadr nexttype)) (setq nexttype (semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration)) (setq idx (1+ idx)) (when (> idx 20) (message "Possible metatype recursion for %S" (semantic-tag-name lasttype)) (throw 'metatype-recursion nil)) )) lasttype)) ;; @ TODO - the typecache can also return a stack of scope names. (defun semantic-analyze-dereference-metatype-1 (ans scope) "Do extra work after dereferencing a metatype. ANS is the answer from the the language specific query. SCOPE is the current scope." (require 'semantic/scope) ;; If ANS is a string, or if ANS is a short tag, we ;; need to do some more work to look it up. (if (stringp ans) ;; The metatype is just a string... look it up. (or (and scope (car-safe ;; @todo - should this be `find the best one'? (semantic-scope-find ans 'type scope))) (let ((tcsans nil)) (prog1 (setq tcsans (semanticdb-typecache-find ans)) ;; While going through the metatype, if we have ;; a scope, push our new cache in. (when scope (semantic-scope-set-typecache scope (semantic-scope-tag-get-scope tcsans)) )) )) (when (and (semantic-tag-p ans) (eq (semantic-tag-class ans) 'type)) ;; We have a tag. (if (semantic-analyze-tag-prototype-p ans) ;; It is a prototype.. find the real one. (or (and scope (car-safe (semantic-scope-find (semantic-tag-name ans) 'type scope))) (let ((tcsans nil)) (prog1 (setq tcsans (semanticdb-typecache-find (semantic-tag-name ans))) ;; While going through the metatype, if we have ;; a scope, push our new cache in. (when scope (semantic-scope-set-typecache scope (semantic-scope-tag-get-scope tcsans)) )))) ;; We have a tag, and it is not a prototype. ans)) )) (provide 'semantic/analyze/fcn) ;;; semantic/analyze/fcn.el ends here