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