Mercurial > emacs
diff lisp/cedet/semantic/lex-spp.el @ 104414:b2b72cdd9d90
cedet/semantic/db.el, cedet/semantic/decorate.el,
cedet/semantic/lex-spp.el, cedet/semantic/util-modes.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Fri, 28 Aug 2009 15:19:20 +0000 |
parents | |
children | c13af98da4d6 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/lex-spp.el Fri Aug 28 15:19:20 2009 +0000 @@ -0,0 +1,1187 @@ +;;; semantic-lex-spp.el --- Semantic Lexical Pre-processor + +;;; Copyright (C) 2006, 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: +;; +;; The Semantic Preprocessor works with semantic-lex to provide a phase +;; during lexical analysis to do the work of a pre-processor. +;; +;; A pre-processor identifies lexical syntax mixed in with another language +;; and replaces some keyword tokens with streams of alternate tokens. +;; +;; If you use SPP in your language, be sure to specify this in your +;; semantic language setup function: +;; +;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) +;; +;; +;; Special Lexical Tokens: +;; +;; There are several special lexical tokens that are used by the +;; Semantic PreProcessor lexer. They are: +;; +;; Declarations: +;; spp-macro-def - A definition of a lexical macro. +;; spp-macro-undef - A removal of a definition of a lexical macro. +;; spp-system-include - A system level include file +;; spp-include - An include file +;; spp-concat - A lexical token representing textual concatenation +;; of symbol parts. +;; +;; Operational tokens: +;; spp-arg-list - Represents an argument list to a macro. +;; spp-symbol-merge - A request for multiple symbols to be textually merged. +;; +;;; TODO: +;; +;; Use `semantic-push-parser-warning' for situations where there are likely +;; macros that are undefined unexpectedly, or other problem. +;; +;; TODO: +;; +;; Try to handle the case of: +;; +;; #define NN namespace nn { +;; #define NN_END } +;; +;; NN +;; int mydecl() {} +;; NN_END +;; + +(require 'semantic/lex) + +;;; Code: +(defvar semantic-lex-spp-macro-symbol-obarray nil + "Table of macro keywords used by the Semantic Preprocessor. +These symbols will be used in addition to those in +`semantic-lex-spp-dynamic-macro-symbol-obarray'.") +(make-variable-buffer-local 'semantic-lex-spp-macro-symbol-obarray) + +(defvar semantic-lex-spp-project-macro-symbol-obarray nil + "Table of macro keywords for this project. +These symbols will be used in addition to those in +`semantic-lex-spp-dynamic-macro-symbol-obarray'.") +(make-variable-buffer-local 'semantic-lex-spp-project-macro-symbol-obarray) + +(defvar semantic-lex-spp-dynamic-macro-symbol-obarray nil + "Table of macro keywords used during lexical analysis. +Macros are lexical symbols which are replaced by other lexical +tokens during lexical analysis. During analysis symbols can be +added and removed from this symbol table.") +(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray) + +(defvar semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil + "A stack of obarrays for temporarilly scoped macro values.") +(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray-stack) + +(defvar semantic-lex-spp-expanded-macro-stack nil + "The stack of lexical SPP macros we have expanded.") +;; The above is not buffer local. Some macro expansions need to be +;; dumped into a secondary buffer for re-lexing. + +;;; NON-RECURSIVE MACRO STACK +;; C Pre-processor does not allow recursive macros. Here are some utils +;; for managing the symbol stack of where we've been. + +(defmacro semantic-lex-with-macro-used (name &rest body) + "With the macro NAME currently being expanded, execute BODY. +Pushes NAME into the macro stack. The above stack is checked +by `semantic-lex-spp-symbol' to not return true for any symbol +currently being expanded." + `(unwind-protect + (progn + (push ,name semantic-lex-spp-expanded-macro-stack) + ,@body) + (pop semantic-lex-spp-expanded-macro-stack))) +(put 'semantic-lex-with-macro-used 'lisp-indent-function 1) + +(add-hook + 'edebug-setup-hook + #'(lambda () + + (def-edebug-spec semantic-lex-with-macro-used + (symbolp def-body) + ) + + )) + +;;; MACRO TABLE UTILS +;; +;; The dynamic macro table is a buffer local variable that is modified +;; during the analysis. OBARRAYs are used, so the language must +;; have symbols that are compatible with Emacs Lisp symbols. +;; +(defsubst semantic-lex-spp-symbol (name) + "Return spp symbol with NAME or nil if not found. +The searcy priority is: + 1. DYNAMIC symbols + 2. PROJECT specified symbols. + 3. SYSTEM specified symbols." + (and + ;; Only strings... + (stringp name) + ;; Make sure we don't recurse. + (not (member name semantic-lex-spp-expanded-macro-stack)) + ;; Do the check of the various tables. + (or + ;; DYNAMIC + (and (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray) + (intern-soft name semantic-lex-spp-dynamic-macro-symbol-obarray)) + ;; PROJECT + (and (arrayp semantic-lex-spp-project-macro-symbol-obarray) + (intern-soft name semantic-lex-spp-project-macro-symbol-obarray)) + ;; SYSTEM + (and (arrayp semantic-lex-spp-macro-symbol-obarray) + (intern-soft name semantic-lex-spp-macro-symbol-obarray)) + ;; ... + ))) + +(defsubst semantic-lex-spp-symbol-p (name) + "Return non-nil if a keyword with NAME exists in any keyword table." + (if (semantic-lex-spp-symbol name) + t)) + +(defsubst semantic-lex-spp-dynamic-map () + "Return the dynamic macro map for the current buffer." + (or semantic-lex-spp-dynamic-macro-symbol-obarray + (setq semantic-lex-spp-dynamic-macro-symbol-obarray + (make-vector 13 0)))) + +(defsubst semantic-lex-spp-dynamic-map-stack () + "Return the dynamic macro map for the current buffer." + (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack + (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack + (make-vector 13 0)))) + +(defun semantic-lex-spp-symbol-set (name value &optional obarray-in) + "Set value of spp symbol with NAME to VALUE and return VALUE. +If optional OBARRAY-IN is non-nil, then use that obarray instead of +the dynamic map." + (if (and (stringp value) (string= value "")) (setq value nil)) + (set (intern name (or obarray-in + (semantic-lex-spp-dynamic-map))) + value)) + +(defsubst semantic-lex-spp-symbol-remove (name &optional obarray) + "Remove the spp symbol with NAME. +If optional OBARRAY is non-nil, then use that obarray instead of +the dynamic map." + (unintern name (or obarray + (semantic-lex-spp-dynamic-map)))) + +(defun semantic-lex-spp-symbol-push (name value) + "Push macro NAME with VALUE into the map. +Reverse with `semantic-lex-spp-symbol-pop'." + (let* ((map (semantic-lex-spp-dynamic-map)) + (stack (semantic-lex-spp-dynamic-map-stack)) + (mapsym (intern name map)) + (stacksym (intern name stack)) + (mapvalue (when (boundp mapsym) (symbol-value mapsym))) + ) + (when (boundp mapsym) + ;; Make sure there is a stack + (if (not (boundp stacksym)) (set stacksym nil)) + ;; If there is a value to push, then push it. + (set stacksym (cons mapvalue (symbol-value stacksym))) + ) + ;; Set our new value here. + (set mapsym value) + )) + +(defun semantic-lex-spp-symbol-pop (name) + "Pop macro NAME from the stackmap into the orig map. +Reverse with `semantic-lex-spp-symbol-pop'." + (let* ((map (semantic-lex-spp-dynamic-map)) + (stack (semantic-lex-spp-dynamic-map-stack)) + (mapsym (intern name map)) + (stacksym (intern name stack)) + (oldvalue nil) + ) + (if (or (not (boundp stacksym) ) + (= (length (symbol-value stacksym)) 0)) + ;; Nothing to pop, remove it. + (unintern name map) + ;; If there is a value to pop, then add it to the map. + (set mapsym (car (symbol-value stacksym))) + (set stacksym (cdr (symbol-value stacksym))) + ))) + +(defsubst semantic-lex-spp-symbol-stream (name) + "Return replacement stream of macro with NAME." + (let ((spp (semantic-lex-spp-symbol name))) + (if spp + (symbol-value spp)))) + +(defun semantic-lex-make-spp-table (specs) + "Convert spp macro list SPECS into an obarray and return it. +SPECS must be a list of (NAME . REPLACEMENT) elements, where: + +NAME is the name of the spp macro symbol to define. +REPLACEMENT a string that would be substituted in for NAME." + + ;; Create the symbol hash table + (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0)) + spec) + ;; fill it with stuff + (while specs + (setq spec (car specs) + specs (cdr specs)) + (semantic-lex-spp-symbol-set + (car spec) + (cdr spec) + semantic-lex-spp-macro-symbol-obarray)) + semantic-lex-spp-macro-symbol-obarray)) + +(defun semantic-lex-spp-save-table () + "Return a list of spp macros and values. +The return list is meant to be saved in a semanticdb table." + (let (macros) + (when (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray) + (mapatoms + #'(lambda (symbol) + (setq macros (cons (cons (symbol-name symbol) + (symbol-value symbol)) + macros))) + semantic-lex-spp-dynamic-macro-symbol-obarray)) + macros)) + +(defun semantic-lex-spp-macros () + "Return a list of spp macros as Lisp symbols. +The value of each symbol is the replacement stream." + (let (macros) + (when (arrayp semantic-lex-spp-macro-symbol-obarray) + (mapatoms + #'(lambda (symbol) + (setq macros (cons symbol macros))) + semantic-lex-spp-macro-symbol-obarray)) + (when (arrayp semantic-lex-spp-project-macro-symbol-obarray) + (mapatoms + #'(lambda (symbol) + (setq macros (cons symbol macros))) + semantic-lex-spp-project-macro-symbol-obarray)) + (when (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray) + (mapatoms + #'(lambda (symbol) + (setq macros (cons symbol macros))) + semantic-lex-spp-dynamic-macro-symbol-obarray)) + macros)) + +(defun semantic-lex-spp-set-dynamic-table (new-entries) + "Set the dynamic symbol table to NEW-ENTRIES. +For use with semanticdb restoration of state." + (dolist (e new-entries) + ;; Default obarray for below is the dynamic map. + (semantic-lex-spp-symbol-set (car e) (cdr e)))) + +(defun semantic-lex-spp-reset-hook (start end) + "Reset anything needed by SPP for parsing. +In this case, reset the dynamic macro symbol table if +START is (point-min). +END is not used." + (when (= start (point-min)) + (setq semantic-lex-spp-dynamic-macro-symbol-obarray nil + semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil + ;; This shouldn't not be nil, but reset just in case. + semantic-lex-spp-expanded-macro-stack nil) + )) + +;;; MACRO EXPANSION: Simple cases +;; +;; If a user fills in the table with simple strings, we can +;; support that by converting them into tokens with the +;; various analyzers that are available. + +(defun semantic-lex-spp-extract-regex-and-compare (analyzer value) + "Extract a regexp from an ANALYZER and use to match VALUE. +Return non-nil if it matches" + (let* ((condition (car analyzer)) + (regex (cond ((eq (car condition) 'looking-at) + (nth 1 condition)) + (t + nil)))) + (when regex + (string-match regex value)) + )) + +(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues) + "Convert lexical macro contents VAL into a macro expansion stream. +These are for simple macro expansions that a user may have typed in directly. +As such, we need to analyze the input text, to figure out what kind of real +lexical token we should be inserting in its place. + +Argument VAL is the value of some macro to be converted into a stream. +BEG and END are the token bounds of the macro to be expanded +that will somehow gain a much longer token stream. +ARGVALUES are values for any arg list, or nil." + (cond + ;; We perform a replacement. Technically, this should + ;; be a full lexical step over the "val" string, but take + ;; a guess that its just a keyword or existing symbol. + ;; + ;; Probably a really bad idea. See how it goes. + ((semantic-lex-spp-extract-regex-and-compare + semantic-lex-symbol-or-keyword val) + (semantic-lex-push-token + (semantic-lex-token (or (semantic-lex-keyword-p val) 'symbol) + beg end + val))) + + ;; Ok, the rest of these are various types of syntax. + ;; Conveniences for users that type in their symbol table. + ((semantic-lex-spp-extract-regex-and-compare + semantic-lex-punctuation val) + (semantic-lex-token 'punctuation beg end val)) + ((semantic-lex-spp-extract-regex-and-compare + semantic-lex-number val) + (semantic-lex-token 'number beg end val)) + ((semantic-lex-spp-extract-regex-and-compare + semantic-lex-paren-or-list val) + (semantic-lex-token 'semantic-list beg end val)) + ((semantic-lex-spp-extract-regex-and-compare + semantic-lex-string val) + (semantic-lex-token 'string beg end val)) + (t nil) + )) + +;;; MACRO EXPANSION : Lexical token replacement +;; +;; When substituting in a macro from a token stream of formatted +;; semantic lex tokens, things can be much more complicated. +;; +;; Some macros have arguments that get set into the dynamic macro +;; table during replacement. +;; +;; In general, the macro tokens are substituted into the regular +;; token stream, but placed under the characters of the original +;; macro symbol. +;; +;; Argument lists are saved as a lexical token at the beginning +;; of a replacement value. + +(defun semantic-lex-spp-one-token-to-txt (tok) + "Convert the token TOK into a string. +If TOK is made of multiple tokens, convert those to text. This +conversion is needed if a macro has a merge symbol in it that +combines the text of two previously distinct symbols. For +exampe, in c: + +#define (a,b) a ## b;" + (let ((txt (semantic-lex-token-text tok)) + (sym nil) + ) + (cond ((and (eq (car tok) 'symbol) + (setq sym (semantic-lex-spp-symbol txt)) + (not (semantic-lex-spp-macro-with-args (symbol-value sym))) + ) + ;; Now that we have a symbol, + (let ((val (symbol-value sym))) + (cond ((and (consp val) + (symbolp (car val))) + (semantic-lex-spp-one-token-to-txt val)) + ((and (consp val) + (consp (car val)) + (symbolp (car (car val)))) + (mapconcat (lambda (subtok) + (semantic-lex-spp-one-token-to-txt subtok)) + val + "")) + ;; If val is nil, that's probably wrong. + ;; Found a system header case where this was true. + ((null val) "") + ;; Debug wierd stuff. + (t (debug))) + )) + ((stringp txt) + txt) + (t nil)) + )) + +(defun semantic-lex-spp-macro-with-args (val) + "If the macro value VAL has an argument list, return the arglist." + (when (and val (consp val) (consp (car val)) + (eq 'spp-arg-list (car (car val)))) + (car (cdr (car val))))) + +(defun semantic-lex-spp-token-macro-to-macro-stream (val beg end argvalues) + "Convert lexical macro contents VAL into a macro expansion stream. +Argument VAL is the value of some macro to be converted into a stream. +BEG and END are the token bounds of the macro to be expanded +that will somehow gain a much longer token stream. +ARGVALUES are values for any arg list, or nil. +See comments in code for information about how token streams are processed +and what valid VAL values are." + + ;; A typical VAL value might be either a stream of tokens. + ;; Tokens saved into a macro stream always includes the text from the + ;; buffer, since the locations specified probably don't represent + ;; that text anymore, or even the same buffer. + ;; + ;; CASE 1: Simple token stream + ;; + ;; #define SUPER mysuper:: + ;; ==> + ;;((symbol "mysuper" 480 . 487) + ;; (punctuation ":" 487 . 488) + ;; (punctuation ":" 488 . 489)) + ;; + ;; CASE 2: Token stream with argument list + ;; + ;; #define INT_FCN(name) int name (int in) + ;; ==> + ;; ((spp-arg-list ("name") 558 . 564) + ;; (INT "int" 565 . 568) + ;; (symbol "name" 569 . 573) + ;; (semantic-list "(int in)" 574 . 582)) + ;; + ;; In the second case, a macro with an argument list as the a rgs as the + ;; first entry. + ;; + ;; CASE 3: Symbol text merge + ;; + ;; #define TMP(a) foo_ ## a + ;; ==> + ;; ((spp-arg-list ("a") 20 . 23) + ;; (spp-symbol-merge ((symbol "foo_" 24 . 28) (symbol "a" 32 . 33)) + ;; 24 . 33)) + ;; + ;; Usually in conjunction with a macro with an argument, merging symbol + ;; parts is a way of fabricating new symbols from pieces inside the macro. + ;; These macros use `spp-symbol-merge' tokens whose TEXT part is another + ;; token stream. This sub-stream ought to consist of only 2 SYMBOL pieces, + ;; though I suppose keywords might be ok. The end result of this example + ;; merge symbol would be (symbol "foo_A" 24 . 33) where A is the symbol + ;; passed in from the arg list "a". + ;; + ;; CASE 4: Nested token streams + ;; + ;; #define FOO(f) f + ;; #define BLA bla FOO(foo) + ;; ==> + ;; ((INT "int" 82 . 85) + ;; (symbol "FOO" 86 . 89) + ;; (semantic-list "(foo)" 89 . 94)) + ;; + ;; Nested token FOO shows up in the table of macros, and gets replace + ;; inline. This is the same as case 2. + + (let ((arglist (semantic-lex-spp-macro-with-args val)) + (argalist nil) + (val-tmp nil) + (v nil) + ) + ;; CASE 2: Dealing with the arg list. + (when arglist + ;; Skip the arg list. + (setq val (cdr val)) + + ;; Push args into the replacement list. + (let ((AV argvalues)) + (dolist (A arglist) + (let* ((argval (car AV))) + + (semantic-lex-spp-symbol-push A argval) + (setq argalist (cons (cons A argval) argalist)) + (setq AV (cdr AV))))) + ) + + ;; Set val-tmp after stripping arguments. + (setq val-tmp val) + + ;; CASE 1: Push everything else onto the list. + ;; Once the arg list is stripped off, CASE 2 is the same + ;; as CASE 1. + (while val-tmp + (setq v (car val-tmp)) + (setq val-tmp (cdr val-tmp)) + + (let* (;; The text of the current lexical token. + (txt (car (cdr v))) + ;; Try to convert txt into a macro declaration. If it is + ;; not a macro, use nil. + (txt-macro-or-nil (semantic-lex-spp-symbol txt)) + ;; If our current token is a macro, then pull off the argument + ;; list. + (macro-and-args + (when txt-macro-or-nil + (semantic-lex-spp-macro-with-args (symbol-value txt-macro-or-nil))) + ) + ;; We need to peek at the next token when testing for + ;; used macros with arg lists. + (next-tok-class (semantic-lex-token-class (car val-tmp))) + ) + + (cond + ;; CASE 3: Merge symbols together. + ((eq (semantic-lex-token-class v) 'spp-symbol-merge) + ;; We need to merge the tokens in the 'text segement together, + ;; and produce a single symbol from it. + (let ((newsym + (mapconcat (lambda (tok) + (semantic-lex-spp-one-token-to-txt tok)) + txt + ""))) + (semantic-lex-push-token + (semantic-lex-token 'symbol beg end newsym)) + )) + + ;; CASE 2: Argument replacement. If a discovered symbol is in + ;; the active list of arguments, then we need to substitute + ;; in the new value. + ((and (eq (semantic-lex-token-class v) 'symbol) txt-macro-or-nil + (or (and macro-and-args (eq next-tok-class 'semantic-list)) + (not macro-and-args)) + ) + (let ((AV nil)) + (when macro-and-args + (setq AV + (semantic-lex-spp-stream-for-arglist (car val-tmp))) + ;; We used up these args. Pull from the stream. + (setq val-tmp (cdr val-tmp)) + ) + + (semantic-lex-with-macro-used txt + ;; Don't recurse directly into this same fcn, because it is + ;; convenient to have plain string replacements too. + (semantic-lex-spp-macro-to-macro-stream + (symbol-value txt-macro-or-nil) + beg end AV)) + )) + + ;; This is a HACK for the C parser. The 'macros text + ;; property is some storage so that the parser can do + ;; some C specific text manipulations. + ((eq (semantic-lex-token-class v) 'semantic-list) + ;; Push our arg list onto the semantic list. + (when argalist + (setq txt (concat txt)) ; Copy the text. + (put-text-property 0 1 'macros argalist txt)) + (semantic-lex-push-token + (semantic-lex-token (semantic-lex-token-class v) beg end txt)) + ) + + ;; CASE 1: Just another token in the stream. + (t + ;; Nothing new. + (semantic-lex-push-token + (semantic-lex-token (semantic-lex-token-class v) beg end txt)) + ) + ))) + + ;; CASE 2: The arg list we pushed onto the symbol table + ;; must now be removed. + (dolist (A arglist) + (semantic-lex-spp-symbol-pop A)) + )) + +;;; Macro Merging +;; +;; Used when token streams from different macros include eachother. +;; Merged macro streams perform in place replacements. + +(defun semantic-lex-spp-merge-streams (raw-stream) + "Merge elements from the RAW-STREAM together. +Handle spp-concat symbol concatenation. +Handle Nested macro replacements. +Return the cooked stream." + (let ((cooked-stream nil)) + ;; Merge the stream + (while raw-stream + (cond ((eq (semantic-lex-token-class (car raw-stream)) 'spp-concat) + ;; handle hashhash, by skipping it. + (setq raw-stream (cdr raw-stream)) + ;; Now merge the symbols. + (let ((prev-tok (car cooked-stream)) + (next-tok (car raw-stream))) + (setq cooked-stream (cdr cooked-stream)) + (push (semantic-lex-token + 'spp-symbol-merge + (semantic-lex-token-start prev-tok) + (semantic-lex-token-end next-tok) + (list prev-tok next-tok)) + cooked-stream) + )) + (t + (push (car raw-stream) cooked-stream)) + ) + (setq raw-stream (cdr raw-stream)) + ) + + (nreverse cooked-stream)) + ) + +;;; MACRO EXPANSION +;; +;; There are two types of expansion. +;; +;; 1. Expansion using a value made up of lexical tokens. +;; 2. User input replacement from a plain string. + +(defun semantic-lex-spp-macro-to-macro-stream (val beg end argvalues) + "Convert lexical macro contents VAL into a macro expansion stream. +Argument VAL is the value of some macro to be converted into a stream. +BEG and END are the token bounds of the macro to be expanded +that will somehow gain a much longer token stream. +ARGVALUES are values for any arg list, or nil." + (cond + ;; If val is nil, then just skip it. + ((null val) t) + ;; If it is a token, then return that token rebuilt. + ((and (consp val) (car val) (symbolp (car val))) + (semantic-lex-push-token + (semantic-lex-token (car val) beg end (semantic-lex-token-text val)))) + ;; Test for a token list. + ((and (consp val) (consp (car val)) (car (car val)) + (symbolp (car (car val)))) + (semantic-lex-spp-token-macro-to-macro-stream val beg end argvalues)) + ;; Test for miscellaneous strings. + ((stringp val) + (semantic-lex-spp-simple-macro-to-macro-stream val beg end argvalues)) + )) + +;;; -------------------------------------------------------- +;;; +;;; ANALYZERS: +;;; + +;;; Symbol Is Macro +;; +;; An analyser that will push tokens from a macro in place +;; of the macro symbol. +;; +(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end) + "Do the lexical replacement for SYM with VAL. +Argument BEG and END specify the bounds of SYM in the buffer." + (if (not val) + (setq semantic-lex-end-point end) + (let ((arg-in nil) + (arg-parsed nil) + (arg-split nil) + ) + + ;; Check for arguments. + (setq arg-in (semantic-lex-spp-macro-with-args val)) + + (when arg-in + (save-excursion + (goto-char end) + (setq arg-parsed + (semantic-lex-spp-one-token-and-move-for-macro + (point-at-eol))) + (setq end (semantic-lex-token-end arg-parsed)) + + (when (and (listp arg-parsed) (eq (car arg-parsed) 'semantic-list)) + (setq arg-split + ;; Use lex to split up the contents of the argument list. + (semantic-lex-spp-stream-for-arglist arg-parsed) + )) + )) + + ;; if we have something to sub in, then do it. + (semantic-lex-spp-macro-to-macro-stream val beg end arg-split) + (setq semantic-lex-end-point end) + ) + )) + +(defvar semantic-lex-spp-replacements-enabled t + "Non-nil means do replacements when finding keywords. +Disable this only to prevent recursive expansion issues.") + +(defun semantic-lex-spp-analyzer-push-tokens-for-symbol (str beg end) + "Push lexical tokens for the symbol or keyword STR. +STR occurs in the current buffer between BEG and END." + (let (sym val) + (cond + ;; + ;; It is a macro. Prepare for a replacement. + ((and semantic-lex-spp-replacements-enabled + (semantic-lex-spp-symbol-p str)) + (setq sym (semantic-lex-spp-symbol str) + val (symbol-value sym) + count 0) + + (let ((semantic-lex-spp-expanded-macro-stack + semantic-lex-spp-expanded-macro-stack)) + + (semantic-lex-with-macro-used str + ;; Do direct replacements of single value macros of macros. + ;; This solves issues with a macro containing one symbol that + ;; is another macro, and get arg lists passed around. + (while (and val (consp val) + (semantic-lex-token-p (car val)) + (eq (length val) 1) + (eq (semantic-lex-token-class (car val)) 'symbol) + (semantic-lex-spp-symbol-p (semantic-lex-token-text (car val))) + (< count 10) + ) + (setq str (semantic-lex-token-text (car val))) + (setq sym (semantic-lex-spp-symbol str) + val (symbol-value sym)) + ;; Prevent recursion + (setq count (1+ count)) + ;; This prevents a different kind of recursion. + (push str semantic-lex-spp-expanded-macro-stack) + ) + + (semantic-lex-spp-anlyzer-do-replace sym val beg end)) + + )) + ;; Anything else. + (t + ;; A regular keyword. + (semantic-lex-push-token + (semantic-lex-token (or (semantic-lex-keyword-p str) 'symbol) + beg end)))) + )) + +(define-lex-regex-analyzer semantic-lex-spp-replace-or-symbol-or-keyword + "Like 'semantic-lex-symbol-or-keyword' plus preprocessor macro replacement." + "\\(\\sw\\|\\s_\\)+" + (let ((str (match-string 0)) + (beg (match-beginning 0)) + (end (match-end 0))) + (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end))) + +;;; ANALYZERS FOR NEW MACROS +;; +;; These utilities and analyzer declaration function are for +;; creating an analyzer which produces new macros in the macro table. +;; +;; There are two analyzers. One for new macros, and one for removing +;; a macro. + +(defun semantic-lex-spp-first-token-arg-list (token) + "If TOKEN is a semantic-list, turn it into a an SPP ARG LIST." + (when (and (consp token) + (symbolp (car token)) + (eq 'semantic-list (car token))) + ;; Convert TOKEN in place. + (let ((argsplit (cedet-split-string (semantic-lex-token-text token) + "[(), ]" t))) + (setcar token 'spp-arg-list) + (setcar (nthcdr 1 token) argsplit)) + )) + +(defun semantic-lex-spp-one-token-and-move-for-macro (max) + "Lex up one token, and move to end of that token. +Don't go past MAX." + (let ((ans (semantic-lex (point) max 0 0))) + (if (not ans) + (progn (goto-char max) + nil) + (when (> (semantic-lex-token-end (car ans)) max) + (let ((bounds (semantic-lex-token-bounds (car ans)))) + (setcdr bounds max))) + (goto-char (semantic-lex-token-end (car ans))) + (car ans)) + )) + +(defun semantic-lex-spp-stream-for-arglist (token) + "Lex up the contents of the arglist TOKEN. +Parsing starts inside the parens, and ends at the end of TOKEN." + (let ((end (semantic-lex-token-end token)) + (fresh-toks nil) + (toks nil)) + (save-excursion + + (if (stringp (nth 1 token)) + ;; If the 2nd part of the token is a string, then we have + ;; a token specifically extracted from a buffer. Possibly + ;; a different buffer. This means we need to do something + ;; nice to parse its contents. + (let ((txt (semantic-lex-token-text token))) + (semantic-lex-spp-lex-text-string + (substring txt 1 (1- (length txt))))) + + ;; This part is like the original + (goto-char (semantic-lex-token-start token)) + ;; A cheat for going into the semantic list. + (forward-char 1) + (setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end))) + (dolist (tok fresh-toks) + (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) + (setq toks (cons tok toks)))) + + (nreverse toks))))) + +(defun semantic-lex-spp-lex-text-string (text) + "Lex the text string TEXT using the current buffer's state. +Use this to parse text extracted from a macro as if it came from +the current buffer. Since the lexer is designed to only work in +a buffer, we need to create a new buffer, and populate it with rules +and variable state from the current buffer." + (let* ((buf (get-buffer-create " *SPP parse hack*")) + (mode major-mode) + (fresh-toks nil) + (toks nil) + (origbuff (current-buffer)) + (important-vars '(semantic-lex-spp-macro-symbol-obarray + semantic-lex-spp-project-macro-symbol-obarray + semantic-lex-spp-dynamic-macro-symbol-obarray + semantic-lex-spp-dynamic-macro-symbol-obarray-stack + semantic-lex-spp-expanded-macro-stack + )) + ) + (set-buffer buf) + (erase-buffer) + ;; Below is a painful hack to make sure everything is setup correctly. + (when (not (eq major-mode mode)) + (funcall mode) + ;; Hack in mode-local + (activate-mode-local-bindings) + ;; CHEATER! The following 3 lines are from + ;; `semantic-new-buffer-fcn', but we don't want to turn + ;; on all the other annoying modes for this little task. + (setq semantic-new-buffer-fcn-was-run t) + (semantic-lex-init) + (semantic-clear-toplevel-cache) + (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook + t) + ;; Second Cheat: copy key variables reguarding macro state from the + ;; the originating buffer we are parsing. + (dolist (V important-vars) + (set V (semantic-buffer-local-value V origbuff))) + ) + (insert text) + (goto-char (point-min)) + + (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max))) + (dolist (tok fresh-toks) + (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) + (setq toks (cons tok toks)))) + + (nreverse toks))) + +;;;; FIRST DRAFT +;; This is the fist version of semantic-lex-spp-stream-for-arglist +;; that worked pretty well. It doesn't work if the TOKEN was derived +;; from some other buffer, in which case it can get the wrong answer +;; or throw an error if the token location in the originating buffer is +;; larger than the current buffer. +;;(defun semantic-lex-spp-stream-for-arglist-orig (token) +;; "Lex up the contents of the arglist TOKEN. +;; Parsing starts inside the parens, and ends at the end of TOKEN." +;; (save-excursion +;; (let ((end (semantic-lex-token-end token)) +;; (fresh-toks nil) +;; (toks nil)) +;; (goto-char (semantic-lex-token-start token)) +;; ;; A cheat for going into the semantic list. +;; (forward-char 1) +;; (setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end))) +;; (dolist (tok fresh-toks) +;; (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) +;; (setq toks (cons tok toks)))) +;; (nreverse toks)) +;; )) + +;;;; USING SPLIT +;; This doesn't work, because some arguments passed into a macro +;; might contain non-simple symbol words, which this doesn't handle. +;; +;; Thus, you need a full lex to occur. +;; (defun semantic-lex-spp-stream-for-arglist-split (token) +;; "Lex up the contents of the arglist TOKEN. +;; Parsing starts inside the parens, and ends at the end of TOKEN." +;; (let* ((txt (semantic-lex-token-text token)) +;; (split (split-string (substring txt 1 (1- (length txt))) +;; "(), " t)) +;; ;; Hack for lexing. +;; (semantic-lex-spp-analyzer-push-tokens-for-symbol nil)) +;; (dolist (S split) +;; (semantic-lex-spp-analyzer-push-tokens-for-symbol S 0 1)) +;; (reverse semantic-lex-spp-analyzer-push-tokens-for-symbol))) + + +(defun semantic-lex-spp-stream-for-macro (eos) + "Lex up a stream of tokens for a #define statement. +Parsing starts at the current point location. +EOS is the end of the stream to lex for this macro." + (let ((stream nil)) + (while (< (point) eos) + (let* ((tok (semantic-lex-spp-one-token-and-move-for-macro eos)) + (str (when tok + (semantic-lex-token-text tok))) + ) + (if str + (push (semantic-lex-token (semantic-lex-token-class tok) + (semantic-lex-token-start tok) + (semantic-lex-token-end tok) + str) + stream) + ;; Nothing to push. + nil))) + (goto-char eos) + ;; Fix the order + (nreverse stream) + )) + +(defmacro define-lex-spp-macro-declaration-analyzer (name doc regexp tokidx + &rest valform) + "Define a lexical analyzer for defining new MACROS. +NAME is the name of the analyzer. +DOC is the documentation for the analyzer. +REGEXP is a regular expression for the analyzer to match. +See `define-lex-regex-analyzer' for more on regexp. +TOKIDX is an index into REGEXP for which a new lexical token +of type `spp-macro-def' is to be created. +VALFORM are forms that return the value to be saved for this macro, or nil. +When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' +to convert text into a lexical stream for storage in the macro." + (let ((start (make-symbol "start")) + (end (make-symbol "end")) + (val (make-symbol "val")) + (startpnt (make-symbol "startpnt")) + (endpnt (make-symbol "endpnt"))) + `(define-lex-regex-analyzer ,name + ,doc + ,regexp + (let ((,start (match-beginning ,tokidx)) + (,end (match-end ,tokidx)) + (,startpnt semantic-lex-end-point) + (,val (save-match-data ,@valform)) + (,endpnt semantic-lex-end-point)) + (semantic-lex-spp-symbol-set + (buffer-substring-no-properties ,start ,end) + ,val) + (semantic-lex-push-token + (semantic-lex-token 'spp-macro-def + ,start ,end)) + ;; Preserve setting of the end point from the calling macro. + (when (and (/= ,startpnt ,endpnt) + (/= ,endpnt semantic-lex-end-point)) + (setq semantic-lex-end-point ,endpnt)) + )))) + +(defmacro define-lex-spp-macro-undeclaration-analyzer (name doc regexp tokidx) + "Undefine a lexical analyzer for defining new MACROS. +NAME is the name of the analyzer. +DOC is the documentation for the analyzer. +REGEXP is a regular expression for the analyzer to match. +See `define-lex-regex-analyzer' for more on regexp. +TOKIDX is an index into REGEXP for which a new lexical token +of type `spp-macro-undef' is to be created." + (let ((start (make-symbol "start")) + (end (make-symbol "end"))) + `(define-lex-regex-analyzer ,name + ,doc + ,regexp + (let ((,start (match-beginning ,tokidx)) + (,end (match-end ,tokidx)) + ) + (semantic-lex-spp-symbol-remove + (buffer-substring-no-properties ,start ,end)) + (semantic-lex-push-token + (semantic-lex-token 'spp-macro-undef + ,start ,end)) + )))) + +;;; INCLUDES +;; +;; These analyzers help a language define how include files +;; are identified. These are ONLY for languages that perform +;; an actual textual includesion, and not for imports. +;; +;; This section is supposed to allow the macros from the headers to be +;; added to the local dynamic macro table, but that hasn't been +;; written yet. +;; +(defcustom semantic-lex-spp-use-headers-flag nil + "*Non-nil means to pre-parse headers as we go. +For languages that use the Semantic pre-processor, this can +improve the accuracy of parsed files where include files +can change the state of what's parsed in the current file. + +Note: Note implemented yet" + :group 'semantic + :type 'boolean) + +(defun semantic-lex-spp-merge-header (name) + "Extract and merge any macros from the header with NAME. +Finds the header file belonging to NAME, gets the macros +from that file, and then merge the macros with our current +symbol table." + (when semantic-lex-spp-use-headers-flag + ;; @todo - do this someday, ok? + )) + +(defmacro define-lex-spp-include-analyzer (name doc regexp tokidx + &rest valform) + "Define a lexical analyzer for defining a new INCLUDE lexical token. +Macros defined in the found include will be added to our running table +at the time the include statement is found. +NAME is the name of the analyzer. +DOC is the documentation for the analyzer. +REGEXP is a regular expression for the analyzer to match. +See `define-lex-regex-analyzer' for more on regexp. +TOKIDX is an index into REGEXP for which a new lexical token +of type `spp-macro-include' is to be created. +VALFORM are forms that return the name of the thing being included, and the +type of include. The return value should be of the form: + (NAME . TYPE) +where NAME is the name of the include, and TYPE is the type of the include, +where a valid symbol is 'system, or nil." + (let ((start (make-symbol "start")) + (end (make-symbol "end")) + (val (make-symbol "val")) + (startpnt (make-symbol "startpnt")) + (endpnt (make-symbol "endpnt"))) + `(define-lex-regex-analyzer ,name + ,doc + ,regexp + (let ((,start (match-beginning ,tokidx)) + (,end (match-end ,tokidx)) + (,startpnt semantic-lex-end-point) + (,val (save-match-data ,@valform)) + (,endpnt semantic-lex-end-point)) + ;;(message "(car ,val) -> %S" (car ,val)) + (semantic-lex-spp-merge-header (car ,val)) + (semantic-lex-push-token + (semantic-lex-token (if (eq (cdr ,val) 'system) + 'spp-system-include + 'spp-include) + ,start ,end + (car ,val))) + ;; Preserve setting of the end point from the calling macro. + (when (and (/= ,startpnt ,endpnt) + (/= ,endpnt semantic-lex-end-point)) + (setq semantic-lex-end-point ,endpnt)) + )))) + +;;; EIEIO USAGE +;; +;; Semanticdb can save off macro tables for quick lookup later. +;; +;; These routines are for saving macro lists into an EIEIO persistent +;; file. +(defvar semantic-lex-spp-macro-max-length-to-save 200 + "*Maximum length of an SPP macro before we opt to not save it.") + +(defun semantic-lex-spp-table-write-slot-value (value) + "Write out the VALUE of a slot for EIEIO. +The VALUE is a spp lexical table." + (if (not value) + (princ "nil") + (princ "\n '(") + ;(princ value) + (dolist (sym value) + (princ "(") + (prin1 (car sym)) + (let* ((first (car (cdr sym))) + (rest (cdr sym))) + (when (not (listp first)) + (error "Error in macro \"%s\"" (car sym))) + (when (eq (car first) 'spp-arg-list) + (princ " ") + (prin1 first) + (setq rest (cdr rest)) + ) + + (when rest + (princ " . ") + (let ((len (length (cdr rest)))) + (cond ((< len 2) + (condition-case nil + (prin1 rest) + (error + (princ "nil ;; Error writing macro\n")))) + ((< len semantic-lex-spp-macro-max-length-to-save) + (princ "\n ") + (condition-case nil + (prin1 rest) + (error + (princ "nil ;; Error writing macro\n "))) + ) + (t ;; Too Long! + (princ "nil ;; Too Long!\n ") + )))) + ) + (princ ")\n ") + ) + (princ ")\n")) +) + +;;; TESTS +;; +(defun semantic-lex-spp-write-test () + "Test the semantic tag writer against the current buffer." + (interactive) + (with-output-to-temp-buffer "*SPP Write Test*" + (semantic-lex-spp-table-write-slot-value + (semantic-lex-spp-save-table)))) + +(defun semantic-lex-spp-write-utest () + "Unit test using the test spp file to test the slot write fcn." + (interactive) + (let* ((sem (locate-library "semantic-lex-spp.el")) + (dir (file-name-directory sem))) + (save-excursion + (set-buffer (find-file-noselect + (expand-file-name "tests/testsppreplace.c" + dir))) + (semantic-lex-spp-write-test)))) + +;;; MACRO TABLE DEBUG +;; +(defun semantic-lex-spp-describe (&optional buffer) + "Describe the current list of spp macros for BUFFER. +If BUFFER is not provided, use the current buffer." + (interactive) + (let ((syms (save-excursion + (if buffer (set-buffer buffer)) + (semantic-lex-spp-macros))) + (sym nil)) + (with-output-to-temp-buffer "*SPP MACROS*" + (princ "Macro\t\tValue\n") + (while syms + (setq sym (car syms) + syms (cdr syms)) + (princ (symbol-name sym)) + (princ "\t") + (if (< (length (symbol-name sym)) 8) + (princ "\t")) + (prin1 (symbol-value sym)) + (princ "\n") + )))) + +;;; EDEBUG Handlers +;; +(add-hook + 'edebug-setup-hook + #'(lambda () + + (def-edebug-spec define-lex-spp-macro-declaration-analyzer + (&define name stringp stringp form def-body) + ) + + (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer + (&define name stringp stringp form) + ) + + (def-edebug-spec define-lex-spp-include-analyzer + (&define name stringp stringp form def-body) + ) + )) + + +(provide 'semantic/lex-spp) + +;;; semantic-lex-spp.el ends here