#!/usr/bin/tclsh

#
# \brief  Regular-expression-based C++ parser
# \author Norman Feske
# \date   2007-08-15
#

# check command line arguments
set config_out_xml    [regsub -- "-format +xml"    $argv "" argv]
set config_out_tokens [regsub -- "-format +tokens" $argv "" argv]
set config_out_source [regsub -- "-format +source" $argv "" argv]
set config_whitespace [regsub -- "-whitespace"     $argv "" argv]

# read file
set input_pathname [lindex $argv 0]
if {[catch {

	#
	# Create root node of the syntax tree
	#
	set txt(0) [exec cat $input_pathname]
	set typ(0) content
	set num 1
}]} {
	foreach line {
		""
		"Parse C++ file and output syntax tree."
		""
		"  usage: parse_cxx \[-whitespace\] \[-format {xml|tokens|source}\] <source_file>"
		""
		"The supported output formats are:"
		""
		"  xml    - XML-based representation"
		"  tokens - List of tokens (parser-internal representation)"
		"  source - Source as generated from syntax tree (for debugging)"
		""
		"If the '-whitespace' argument is specified, whitespaces get translated to tokens."
		""
	} { puts stderr $line }

	exit -1;
}

# do not stop parsing (this variable is only used for debugging)
set stop 0

#
# Replace all '&' characters from the original input
# because they cause trouble with the regexp command.
#
regsub -all {&} $txt(0) "³" txt(0)


##
# Extract expression from content
#
# All expressions that occur in the token types 'typelist'
# and that match the 'subexpr' criterion get replaced in
# their original token by a reference tag and form a new
# token of the type 'newtype'.
#
# The reference is coded as §<token_type><token_id>°.
# Since the reference has the type coded in, we can
# match sub tokens of specific types via plain regular
# expressions.
##
proc extract {newtype subexpr typelist} {
	global num txt typ stop
	set old_num $num

	if {$stop} { return }

	for {set i 0} {$i < $old_num} {incr i} {
		if {[lsearch $typelist $typ($i)] > -1} {
			while {[regexp $subexpr $txt($i) mid]} {

				# new sub text #
				set typ($num) $newtype
				set txt($num) $mid

				# substitute expression by a reference #
				regsub $subexpr $txt($i)  "§$newtype$num°" txt($i)
				incr num
			}
		}
	}
}


##
# Extract operations
#
# \param op_name  name of operator
# \param op_type  type of operator, can be "binary", "pre", or "post"
# \param op_dir   direction of application, can be "ltr" (left to
#                 right) or "trl" (right to left)
##
proc extract_op {newtype op_name op_type op_dir typelist} {
	global num txt typ stop
	set old_num $num

	if {$stop} { return }

	# Extracting operators is context-sensitive. In particular,
	# unary operators must not be applied if they have an
	# operand as neighbor. Hence, we construct a pattern with
	# three subpatterns, one for the leading context, one for
	# the new operand sub token, and one for the trailing context.

	if {$op_dir == "ltr"} {
		set lpattern ""
	} else {
		set lpattern ".*"
	}

	set repl_left {\1}
	if {$op_type == "pre"} {
		set pattern "(^|$lpattern\(?:\[^i\]er|\[^e\]r|\[^r\\d\]\)\\d+°\\s*)(§$op_name\\d+°\\s*§identifier\\d+°)" }
		set repl_right {}
	if {$op_type == "post"} {
		set pattern "($lpattern)(§identifier\\d+°\\s*§$op_name\\d+°\\s*)((§(\[^i\]|i\[^d\]|id\[^e\]))|;|\$)" }
		set repl_right {\3}
	if {$op_type == "binary"} {
		set pattern "($lpattern)(§identifier\\d+°\\s*§$op_name\\d+°\\s*§identifier\\d+°)"
		set repl_right {}
	}

	for {set i 0} {$i < $old_num} {incr i} {
		if {[lsearch $typelist $typ($i)] > -1} {

			while {[regexp $pattern $txt($i) dummy lcontext match rcontext]} {

				# new sub text #
				set typ($num) $newtype
				set txt($num) $match

				set old_txt $txt($i)

				# substitute expression by a reference #
				regsub $pattern $txt($i)  "$repl_left§$newtype$num°$repl_right" txt($i)

				incr num
			}
		}
	}
}


proc extract_operations { from } {
	set operators { { doublecolon    binary ltr }
	                { parenblk       post   ltr # function call }
	                { arrayindex     post   ltr }
	                { deref          binary ltr }
	                { dot            binary ltr }
	                { incr           post   ltr }
	                { decr           post   ltr }
	                { not            pre    rtl }
	                { tilde          pre    rtl }
	                { incr           pre    rtl }
	                { decr           pre    rtl }
	                { minus          pre    rtl }
	                { plus           pre    rtl }
	                { star           pre    rtl # deref }
	                { amper          pre    rtl # addrof }
	                { keysizeof      pre    rtl }
	                { parenblk       pre    rtl # cast }
	                { star           binary ltr }
	                { div            binary ltr }
	                { mod            binary ltr }
	                { plus           binary ltr }
	                { minus          binary ltr }
	                { lshift         binary ltr }
	                { rshift         binary ltr }
	                { less           binary ltr }
	                { lessequal      binary ltr }
	                { greater        binary ltr }
	                { greaterequal   binary ltr }
	                { equal          binary ltr }
	                { notequal       binary ltr }
	                { amper          binary ltr # bitand }
	                { xor            binary ltr }
	                { bitor          binary ltr }
	                { and            binary ltr }
	                { or             binary ltr }
	                { cond           binary ltr }
	                { assign         binary rtl }
	                { assignopplus   binary rtl }
	                { assignopminus  binary rtl }
	                { assignopmult   binary rtl }
	                { assignopdiv    binary rtl }
	                { assignopmod    binary rtl }
	                { assignopbitand binary rtl }
	                { assignopbitxor binary rtl }
	                { assignopbitor  binary rtl }
	                { assignoplshift binary rtl }
	                { assignoprshift binary rtl }
	                { keythrow       pre    rtl }
	                { comma          binary ltr }
	            }

	foreach op $operators {
		set op_name [lindex $op 0]
		set op_type [lindex $op 1]
		set op_dir  [lindex $op 2]
		extract_op identifier $op_name $op_type $op_dir $from
	}
}


proc extract_enum_operations { from } {
	set operators { { doublecolon    binary ltr }
	                { parenblk       post   ltr # function call }
	                { not            pre    rtl }
	                { tilde          pre    rtl }
	                { minus          pre    rtl }
	                { plus           pre    rtl }
	                { amper          pre    rtl # addrof }
	                { keysizeof      pre    rtl }
	                { star           binary ltr }
	                { div            binary ltr }
	                { mod            binary ltr }
	                { plus           binary ltr }
	                { minus          binary ltr }
	                { lshift         binary ltr }
	                { rshift         binary ltr }
	                { less           binary ltr }
	                { lessequal      binary ltr }
	                { greater        binary ltr }
	                { greaterequal   binary ltr }
	                { equal          binary ltr }
	                { notequal       binary ltr }
	                { amper          binary ltr # bitand }
	                { xor            binary ltr }
	                { bitor          binary ltr }
	                { and            binary ltr }
	                { or             binary ltr }
	                { cond           binary ltr }
	            }

	foreach op $operators {
		set op_name [lindex $op 0]
		set op_type [lindex $op 1]
		set op_dir  [lindex $op 2]
		extract_op identifier $op_name $op_type $op_dir $from
	}
}


##
# Refine types of sub tokens
#
# This function changes the type of sub tokens of the specified
# environment token to the specified replacement type.  It is
# used to specialize token types depending on their environment.
# For example, for turning blocks within classes into specialized
# declaration blocks, for which other rules apply than for
# function-body blocks.
##
proc refine_sub_tokens {env_type sub_type repl_sub_type} {
	global num txt typ stop

	if {$stop} { return }

	# iterate through token list in search of env-typed tokens
	for {set i 0} {$i < $num} {incr i} {
		if {$typ($i) == $env_type} {

			set env $txt($i)
			while {[regexp "§$sub_type\(\\d+)°" $env dummy sub_token_idx]} {
				set typ($sub_token_idx) $repl_sub_type
				regsub "§$sub_type\(\\d+)°" $env "§$repl_sub_type$sub_token_idx°" env
			}

			# update environment token
			set txt($i) $env
		}
	}
}


#####################################################
## Rules for splitting the input into its elements ##
#####################################################

#
# Starting with only the root token (content0) of the syntax tree
# containing the whole source code as one string, we extract
# typed sub tokens to partition the string into parts of distinct
# meanings (token types).  In the process of subsequently
# applying extraction rules to specific token types, a syntax
# tree is formed.
#

# extract line comments
extract lcomment {/\*[^\n]*?\*/} content

# extract multi-line comments
extract mlcomment {/\*.*?\*/} content

extract quotedchar {'(.|\\.)'} content

# extract strings
#
# Strings may contain quoted '"' characters.
#
extract string {\"([^\"]|\")*?\"} content

# extract C++-style comments
extract cxxcomment {\/\/[^\n]*} content

# extract preprocessor directives
#
# Preprocessor macros may span over multiple lines if a
# backslash is supplied at the end of each line.
#
extract preproc {#([^\n]|\\\n)*} content

extract preprefix {#} preproc

# extract keywords
foreach keyword {
	private public protected unsigned extern
	while for if else switch do return typedef
	static_cast reinterpret_cast dynamic_cast
	using namespace class struct union enum template
	const inline static virtual friend explicit
	volatile case default operator new throw alignas
	try catch continue sizeof asm override typename constexpr
	GENODE_RPC GENODE_RPC_THROW
	GENODE_RPC_INTERFACE GENODE_RPC_INTERFACE_INHERIT
	GENODE_TYPE_LIST
} {
	set keytag $keyword
	regsub -all {_} $keytag "" keytag
	set keytag [string tolower $keytag]
	extract "key$keytag" "\\m$keyword\\M" content
}

# extract extern "C"
extract "keyexternc" {§keyextern\d+°\s*§string\d+°} content

# fold parenthesis and blocks
extract parenblk {\([^()]*?\)} {content parenblk}
extract block    {\{[^{}]*?\}} {content parenblk block}
extract openbrace  "\{" block
extract closebrace "\}" block
extract openparen  {\(} parenblk
extract closeparen {\)} parenblk

extract externcblk {§keyexternc\d+°\s*§block\d+°} content

# extract template argument blocks
extract tplargs    {<[^<>{}]*>$} {content block parenblk}
extract tplargs    {<[^<>{}]*>(?=[^>])} {content block parenblk}

# extract special characters
extract equal          {==}   {content block parenblk tplargs}
extract assignopplus   {\+=}  {content block parenblk tplargs}
extract assignopminus  {\-=}  {content block parenblk tplargs}
extract assignopmult   {\*=}  {content block parenblk tplargs}
extract assignopdiv    {\/=}  {content block parenblk tplargs}
extract assignopmod    {%=}   {content block parenblk tplargs}
extract assignopbitor  {\|=}  {content block parenblk tplargs}
extract assignopbitand {³=}   {content block parenblk tplargs}
extract assignopbitxor {\^=}  {content block parenblk tplargs}
extract assignopneq    {\!=}  {content block parenblk tplargs}
extract assignoplshift {<<=}  {content block parenblk tplargs}
extract assignoprshift {>>=}  {content block parenblk tplargs}
extract incr           {\+\+} {content block parenblk tplargs}
extract decr           {\-\-} {content block parenblk tplargs}
extract doublecolon    {::}   {content block parenblk tplargs}
extract or             {\|\|} {content block parenblk tplargs}
extract bitor          {\|}   {content block parenblk tplargs}
extract and            {³³}   {content block parenblk tplargs}
extract amper          {³}    {content block parenblk tplargs}
extract plus           {\+}   {content block parenblk tplargs}
extract div            {\/}   {content block parenblk tplargs}
extract star           {\*}   {content block parenblk tplargs}
extract notequal       {\!=}  {content block parenblk tplargs}
extract not            {\!}   {content block parenblk tplargs}
extract deref          {\->}  {content block parenblk tplargs}
extract dot            {\.}   {content block parenblk tplargs}
extract tilde          {~}    {content block parenblk tplargs}
extract lshift         {<<}   {content block parenblk tplargs}
extract rshift         {>>}   {content block parenblk tplargs}
extract greaterequal   {>=}   {content block parenblk tplargs}
extract lessequal      {<=}   {content block parenblk tplargs}
extract greater        {>}    {content block parenblk tplargs}
extract less           {<}    {content block parenblk tplargs}
extract minus          {\-}   {content block parenblk tplargs}
extract mod            {%}    {content block parenblk tplargs}
extract xor            {\^}   {content block parenblk tplargs}
extract question       {\?}   {content block parenblk tplargs}
extract comma          {,}    {content block parenblk tplargs}
extract assign         {=}    {content block parenblk tplargs}

extract attribute {__attribute__\s*§parenblk\d+°} {content block parenblk}

extract alignas {§keyalignas\d+°\s*§parenblk\d+°} {content block parenblk}

# extract identifiers
extract identifier {([\w_][\w\d_]*)+(?=[^°]*(§|$))} {content parenblk block tplargs}

extract identifier {§quotedchar\d+°} {content parenblk block tplargs}

# merge template arguments with the predecessing identifier
extract identifier {§identifier\d+°\s*§tplargs\d+°} {content block parenblk tplargs}

# extract using namespace
extract using {§keyusing\d+°\s*§keynamespace\d+°\s*§identifier\d+°\s*;} {content block}

# extract casted identifiers and thereby potentially creating new valid assignments
extract identifier {§key(static|dynamic|reinterpret)cast\d+°\s*§tplargs\d+°\s*§parenblk\d+°} {block}

#
# XXX the C++ precedence rules are not fully implemented
#

# extract namespaced identifiers
extract identifier {§identifier\d+°\s*§doublecolon\d+°\s*§identifier\d+°} {content block}

# extract identifiers in the root namespace
extract identifier {§doublecolon\d+°\s*§identifier\d+°} {content block}

extract whilecond {§keywhile\d+°\s*§parenblk\d+°} block
extract forcond {§keyfor\d+°\s*§parenblk\d+°} block
extract ifcond {§keyif\d+°\s*§parenblk\d+°} block
extract switchcond {§keyswitch\d+°\s*§parenblk\d+°} block
extract catchcond {§keycatch\d+°\s*§parenblk\d+°} block

# extract forward declarations of structs and classes
extract classdecl  {§keyclass\d+°\s*§identifier\d+°\s*;}  {content block}
extract structdecl {§keystruct\d+°\s*§identifier\d+°\s*;} {content block}

# extract classes
extract class   {(§mlcomment\d+° *\n[ \t]*)?§keyclass\d+°\s*(§alignas\d+°\s*)?§identifier\d+°[^;]*;}  {content block}
extract struct  {(§mlcomment\d+° *\n[ \t]*)?§keystruct\d+°\s*(§alignas\d+°\s*)?§identifier\d+°[^;]*;} {content block}
extract union   {(§mlcomment\d+° *\n[ \t]*)?§keyunion\d+°\s*§identifier\d+°[^;]*;}  {content block}
extract enum    {(§mlcomment\d+° *\n[ \t]*)?§keyenum\d+°\s*[^;]*;}                  {content block}

extract inherit {:.*?(?=\s*§block\d+°)} {class struct union}

# partition block types into more expressive sub types
refine_sub_tokens class  block classblock
refine_sub_tokens struct block classblock
refine_sub_tokens union  block classblock
refine_sub_tokens enum   block enumblock

extract_enum_operations enumblock

#enumvalue {§identifier\d+°[^,]*?(?=§comma\d+°)} enumblock
extract enumentry {§identifier\d+°\s*§assign\d+°\s*§identifier\d+°} enumblock
extract enumvalue {§identifier\d+°$} enumentry
extract enumentry {§identifier\d+°} enumblock

# extract template classes
extract tplclassdecl {(§mlcomment\d+°[\t ]*\n[\t ]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§classdecl\d+°} {content block classblock}
extract tplstructdecl {(§mlcomment\d+°[\t ]*\n[\t ]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§structdecl\d+°} {content block classblock}

extract tplclass {(§mlcomment\d+°[\t ]*\n[\t ]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§class\d+°} {content block classblock}
extract tplstruct {(§mlcomment\d+°[\t ]*\n[\t ]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§struct\d+°} {content block classblock}

refine_sub_tokens tplclassdecl classdecl class;
refine_sub_tokens tplstructdecl structdecl class;

extract arrayindex {\[[^\]]*\]} {content classblock block arrayindex}

# detect case labels within switch statements and protection labels
extract caselabel {§keycase\d+°[^:]+:} {block}
extract caselabel {§keydefault\d+°:} {block}
foreach keyword { private public protected } {
	set label label
	extract "$keyword$label" "§key$keyword\\d+°:" {classblock} }

extract identifier {§identifier\d+°+\s*§doublecolon\d+°\s*§identifier\d+°} {content classblock}

# extract class initialize list
extract initializer {:\s*§identifier\d+°\s*§parenblk\d+°(\s*§comma\d+°\s*§identifier\d+°\s*§parenblk\d+°)*} {content classblock}
extract colon {:}   {initializer inherit}

# extract asm blocks
extract asm {§keyasm\d+°\s*(§keyvolatile\d+°)?\s*§parenblk\d+°} {content block}

# extract Genode-specific RPC declaration macros
set genode_macros { genoderpc genoderpcthrow genoderpcinterface genoderpcinterfaceinherit genodetypelist }
foreach key $genode_macros {
	extract $key "§key$key\\d+°\\s*§parenblk\\d+°\\s*" { classblock parenblk } }

foreach key $genode_macros {
	refine_sub_tokens $key parenblk macroargblk }

# extract functions
extract operatorfunction {§keyoperator\d+°\s*§[^°]+\d+°\s*§parenblk\d+°} {content classblock}
extract funcptr {§parenblk\d+°\s*§parenblk\d+°(\s*§attribute\d+°)?} {content classblock block identifier parenblk}
extract function {§identifier\d+°\s*§parenblk\d+°(\s*§attribute\d+°)?} {content classblock block initializer}

extract operator {§keyoperator\d+°\s*§[^ ]+\d+°} operatorfunction

extract destfunction {(§identifier\d+°§doublecolon\d+°)?§tilde\d+°§identifier\d+°\s*§parenblk\d+°} {content classblock}
extract identifier {(§identifier\d+°§doublecolon\d+°)?§tilde\d+°§identifier\d+°} destfunction

extract identifier {§identifier\d+°\s*§parenblk\d+°} {parenblk block identifier initializer tplargs}
extract identifier {§parenblk\d+°} {parenblk block}

# extract arrays
extract array {(§identifier\d+°\s*)(§arrayindex\d+°\s*)+} {content classblock block}
extract identifier {§array\d+°} {content classblock block}

# extract assignments
extract identifier {(?=(\s*|;))(§star\d+°\s*)*§identifier\d+°\s*§assign\w*\d+°[^;]*} block

# extract throw statements
extract identifier {(?=(\s*|;))§keythrow\d+°\s*[^;]*} block

# extract stream operators
#extract lhidentifier {(?=(\s*|;))[^;]*?§(lshift|rshift)\d+°[^;]*} block

# extract uses of the new operator
extract identifier {§keynew\d+°\s*(§parenblk\d+°\s*)?§function\d+°} block

# extract return statements
extract return {§keyreturn\d+°[^;]*} {block}

# extract modifiers
extract modifier {(§key(extern|externc|constexpr|static|inline|virtual|volatile)\d+°\s*)+} {content classblock block}

# extract function declarations
extract funcdecl {(§mlcomment\d+° *\n[ \t]*)?(§(modifier|keyunsigned|keyconst)\d+°\s*)*§(identifier|keyunsigned|keyconst)\d+°(\s|(§amper\d+°)|(§star\d+°))*§(operator)?function\d+°\s*(§(keyconst|keyoverride)\d+°\s*)*(§assign\d+°\s*§identifier\d+°)?\s*;} {content block classblock}

# extract function implementations
extract funcimpl {(§mlcomment\d+° *\n[ \t]*)?(§(modifier|keyunsigned|keyconst)\d+°\s*)*(§(identifier|keyunsigned|keyconst)\d+°\s*)+(\s|(§amper\d+°)|(§star\d+°))*§(operator)?function\d+°\s*(§(keyconst|keyoverride)\d+°\s*)*(§attribute\d+°\s*)*§block\d+°[;\t ]*} {content block classblock}
extract funcimpl {(§mlcomment\d+° *\n[ \t]*)?§operatorfunction\d+°\s*(§modifier\d+°\s*)?§block\d+°[;\t ]*} {content block classblock}

# extract template functions
extract tplfunc {(§mlcomment\d+° *\n[ \t]*)?§keytemplate\d+°\s*§tplargs\d+°\s*(§attribute\d+°\s*)*§funcimpl\d+°} {content block classblock}

# extract template functions declarations
extract tplfuncdecl {(§mlcomment\d+° *\n[ \t]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§funcdecl\d+°} {content block classblock}

# extract destructor implementations
extract destimpl {(§mlcomment\d+° *\n[ \t]*)?(§modifier\d+°\s*)?§tilde\d+°§function\d+°\s*§block\d+°[;\t ]*} {content classblock}
refine_sub_tokens destimpl destfunction function

# extract constructor implementations
extract constimpl {(§mlcomment\d+° *\n[ \t]*)?(§(modifier|keyexplicit)\d+°\s*)*§function\d+°\s*(§initializer\d+°\s*)?\s*§block\d+°[;\t ]*} {content classblock}

# extract template constructors
extract tplfunc {(§mlcomment\d+° *\n[ \t]*)?§keytemplate\d+°\s*§tplargs\d+°\s*§constimpl\d+°} {content block classblock}

# extract destructor declarations
extract destdecl {(§mlcomment\d+° *\n[ \t]*)?(§modifier\d+°\s*)?§tilde\d+°§function\d+°\s*(§assign\d+°\s+§identifier\d+°)?\s*;} {classblock}

# extract constructor declarations
extract constdecl {(§mlcomment\d+° *\n[ \t]*)?(§keyexplicit\d+°[ \t]*)?§function\d+°\s*(§assign\d+°\s+§identifier\d+°)?\s*;} {classblock}

# extract friendship declarations
extract frienddecl {§keyfriend\d+°\s*§classdecl\d+°} {classblock}

# classify function signatures and their containing argument-parenthesis blocks
foreach env_type [list destdecl constdecl destimpl constimpl funcimpl funcdecl] {
	refine_sub_tokens $env_type function funcsignature }
refine_sub_tokens funcsignature parenblk argparenblk
refine_sub_tokens operatorfunction parenblk argparenblk

extract_operations parenblk
extract argmodifier {(§key(const|volatile)\d+°\s*)+} {argparenblk}

# extract pure-virtual assignments
extract virtassign {§assign\d+°\s+§identifier\d+°} funcdecl

# extract return values
extract retval {(§(identifier|keyunsigned|keyconst|star|amper)\d+°\s*)+(?=§funcsignature)} {funcdecl funcimpl}
extract retval {(§(identifier|keyunsigned|keyconst|star|amper)\d+°\s*)+(?=§operatorfunction)} {funcdecl funcimpl}
extract identifier {§(keyunsigned|keyconst)\d+°\s*(§identifier\d+°)?} {retval}

# extract argument declarations separated by commas
refine_sub_tokens tplargs greater closeparen
refine_sub_tokens tplargs less    openparen
extract varargs {(§dot\d+°){3}} {argparenblk tplargs}
extract keytypename {§keytypename\d+°\s*§varargs\d+°} tplargs

extract argdecl {(§(argmodifier|keytypename|keyunsigned|identifier|tilde|minus|amper|star|and|varargs|assign|string)\d+°\s*)+(?=§comma)}      {argparenblk tplargs}
extract argdecl {(§(argmodifier|keytypename|keyunsigned|identifier|tilde|minus|amper|star|and|varargs|assign|string)\d+°\s*)+(?=§closeparen)} {argparenblk tplargs}
extract argdefault {§assign\d+°.*} argdecl

extract argname {§identifier\d+°\s*(?=§argdefault)} {argdecl}

# there may be just a type and no name
extract argtype {^\s*§identifier\d+°\s*$} {argdecl}

# the last identifier is the name
extract argname {§identifier\d+°\s*$} {argdecl}
extract argtype {^(§(argmodifier|keyunsigned)\d+°\s*)*(§(identifier|keytypename|varargs|keyunsigned)\d+°)(\s*|(§(amper|and|argmodifier)\d+°)|(§star\d+°))*(§argmodifier\d+°\s*)*(§varargs\d+°)?} argdecl

# extract typedefs
extract typedef {(§mlcomment\d+° *\n[ \t]*)?§keytypedef\d+°(\s*§(identifier|keyunsigned|keytypename)\d+°)+\s*;} {content classblock block}
extract typename {§identifier\d+°(?=;)} typedef
extract identifier {(\s*§(identifier|keyunsigned)\d+°){2,}} typedef
extract identifier {\s*§keyunsigned\d+°} typedef

# extract function pointers
extract vardecl {(§(modifier|keyunsigned)\d+°\s*)*(§(identifier|keyunsigned)\d+°)((\s|(§amper\d+°)|(§star\d+°))*(§modifier\d+°\s*)*(§funcptr\d+°)\s*(:\s*§identifier\d+°)?\s*(§assign\d+°[^;]*?)?\s*(§comma\d+°)?\s*)+;} {content classblock block}

# extract variable declarations (type + any number of comma-separated variables + optional tailing comment)
extract vardecl {(§alignas\d+°\s*)?(§(modifier|keyunsigned)\d+°\s*)*(§(identifier|keyunsigned)\d+°)((\s|(§amper\d+°)|(§star\d+°))*(§(modifier|keyconst)\d+°\s*)*(§(identifier|array)\d+°)\s*(:\s*§identifier\d+°)?\s*(§assign\d+°[^;]*?)?(§block\d+°)?\s*(§comma\d+°)?\s*)+;} {content classblock block}

# extract commented variable declaration
extract commentedvardecl {§vardecl\d+°\s*§m?lcomment\d+°(\s*§lcomment\d°)*} {content classblock block}

# extract valid declaration sequences
set elem "(mlcomment|lcomment|vardecl|array|commentedvardecl|typedef|funcimpl|funcdecl|enum|class|struct|union|constimpl|constdecl|destimpl|destdecl|tplfunc|tplfuncdecl|tplstruct|tplstructdecl|tplclass|tplclassdecl|frienddecl|classdecl|structdecl)"
extract declseq "§$elem\\d+°(\\s*§$elem\\d+°)*" {classblock}

# group protection scopes with corresponding declaration sequences
foreach keyword { private public protected } {
	set label label
	extract $keyword "§$keyword$label\\d+°\\s*§declseq\\d+°" {classblock} }

# extract protection-scope labels
extract label {§key(private|public|protected)\d+°:} {private public protected}

# extract name spaces
extract namespace {§keynamespace\d+°\s*§identifier\d+°\s*§block\d+°} {content block}
refine_sub_tokens namespace block namespaceblock

#
# The remaining block tokens are code blocks. So we can
# apply code-specific rules to them.
#

extract identifier {§function\d+°} block

extract_operations {block identifier}

# extract statements from remaining code blocks
extract statement {§asm\d+°;} block
extract statement {§identifier\d+°;} block
extract statement {§return\d+°;}     {block}
extract statement {§keycontinue\d+°\s*;} block

# extract try-catch statements
extract statement {§keytry\d+°\s*§block\d+°(\s*§catchcond\d+°\s*§block\d+°)+} {block}

# wrap blocks into statements
extract statement {§block\d+°} {block statement}

# empty statements (all normal semicolons should be encapsulated in statements now)
extract statement {;} {block}

# turn control structures into statements
set pattern_ifelse {(§ifcond\d+°(\s|§m?lcomment\d+°)*§statement\d+°(\s|§m?lcomment\d+°)*§keyelse\d+°(\s|§m?lcomment\d+°)*§statement\d+°)}
set pattern_if     {(§ifcond\d+°(\s|§m?lcomment\d+°)*§statement\d+°(?!(\s|§m?lcomment\d+°)*§keyelse))}
set pattern_for    {(§(while|for|switch)cond\d+°(\s|§m?lcomment\d+°)*§statement\d+°)}
extract statement "($pattern_ifelse|$pattern_if|$pattern_for)" {block statement}

# extract control-structure types
extract ifelse $pattern_ifelse                                         {statement}
extract if     $pattern_if                                             {statement}
extract for    {§forcond\d+°(\s|§m?lcomment\d+°)*(§statement\d+°|;)}   {statement}
extract while  {§whilecond\d+°(\s|§m?lcomment\d+°)*(§statement\d+°|;)} {statement}
extract switch {§switchcond\d+°(\s|§m?lcomment\d+°)*§statement\d+°}    {statement}

# turn control-flow element into statements
foreach type { ifelse if while for switch try } {
	extract statement "§$type\\d+°" block }

# extract valid code sequences
set elem "(mlcomment|vardecl|statement|lcomment)"
extract codeseq "§$elem\\d+°(\\s*§$elem\\d+°)*" {block}

#
# Extract line breaks, spaces, and tabs from all types
#

if {$config_whitespace} {
	set all_types ""
	for {set i 0} {$i < $num} {incr i} {
		if {[lsearch $all_types $typ($i)] == -1} {
			lappend all_types $typ($i) }}
	
	extract line {\n}       $all_types
	extract align { +(?= )} $all_types
	extract space { }       $all_types
	extract tab   {\t}      $all_types
}


###############################
## Back-end helper functions ##
###############################

##
# Return name of reference token with specified index
##
proc token_by_idx {idx} {
	global typ;
	return "$typ($idx)$idx"
}


##
# Return index of specified reference token
##
proc idx_of_token {token} {
	regexp {[0-9]+} $token idx
	return $idx
}


##
# Return type of specified reference token
##
proc type_of_token {token} {
	regexp {[a-z]+} $token type
	return $type
}


##
# Return marker for reference token
##
proc marker {token} {
	return "§$token°"
}


##
# Return text referenced by token
##
proc token_text {token} {
	global txt
	return $txt([idx_of_token $token])
}


##
# Assign a line number to each reference token
#
# To be able to provide error messages including line numbers, we
# determine the line number for each reference token and store it
# as an attribute.
#
# The result of the function is stored in the global 'ln' array.
##
proc assign_line_numbers {{token content0}} {
	global ln curr_ln config_whitespace

	if {$token == "content0"} { set curr_ln 1 }

	# assign current line number to current token
	set ln([idx_of_token $token]) $curr_ln

	# count occurrences of line breaks
	if {[type_of_token $token] == "line"} { incr curr_ln }
	if {!$config_whitespace && ($token == "\n")} { incr curr_ln }

	# count lines for all sub-tokens
	set tex [token_text $token]
	while {$tex != ""} {

		# count and eat raw line breaks (needed if 'whitespace' option is disabled)
		if {[regexp {^\n} $tex dummy]} {
			if {!$config_whitespace} { incr curr_ln }
			regsub {\n} $tex "" tex
		}

		# ignore plain text
		if {[regexp {^[^§\n]+} $tex plain]} {
			regsub {^[^§\n]+} $tex "" tex }

		# traverse into token
		if {[regexp {^§(.+?)°} $tex dummy token]} {
			assign_line_numbers $token
			regsub {§(.+?)°} $tex "" tex
		}
	}
}


##
# Look up line number of specified reference token
##
proc line_number {token} {
	global ln
	return $ln([idx_of_token $token])
}


##
# Output tokens as valid Tcl List
#
# The result of this function can be used directly
# as input by another Tcl script.
##
proc dump_tokens { } {
	global num typ txt
	set tokens [list]

	for {set i 0} {($i < $num)} {incr i} {
		set token [token_by_idx $i]
		set text $txt($i)

		lappend tokens [list $token [line_number $token] $text]
	}
	puts $tokens
}


##########################
## Source-code back end ##
##########################

##
# Output syntax tree as source code
#
# This constructs the source code from the syntax tree. It is
# useful to check the result against the input to make sure that
# no information gets lost during the parsing procedure.
##
proc dump_source { } {
	global num typ txt

	set output $txt(0)

	while {[regexp {§(.+?)°} $output dummy token]} {
		regsub $dummy $output [token_text $token] output
	}

	# revert character substitutions of '&'
	regsub -all {³} $output "\\\&" output

	puts $output
}


##################
## XML back end ##
##################

proc dump_xml_subtree {token} {
	global dump_xml_indent line

	set type [type_of_token $token]
	set tex  [token_text    $token]
	set line [line_number   $token]

	# shorten frequent leaf nodes
	if {$type == "line"} {
		puts "$dump_xml_indent<linebreak line=\"$line\"/>"
	} elseif {$type == "tab"} {
		puts "$dump_xml_indent<tab line=\"$line\"/>"
	} elseif {$type == "space"} {
		puts "$dump_xml_indent<space line=\"$line\"/>"
	} elseif {$type == "align"} {
		puts "$dump_xml_indent<align line=\"$line\">$tex</align>"
	} else {

		puts "$dump_xml_indent<$type line=\"$line\">"
		set dump_xml_indent "  $dump_xml_indent"

		while {$tex != ""} {

			# consume plain text
			if {[regexp {^[^§]+} $tex plain]} {

				# perform character substitutions for xml compliance
				regsub -all {³}  $plain "\\\&amp;"  plain
				regsub -all {<}  $plain "\\\&lt;"   plain
				regsub -all {>}  $plain "\\\&gt;"   plain
				regsub -all "\"" $plain "\\\&quot;" plain
				regsub -all "'"  $plain "\\\&apos;" plain

				puts "$dump_xml_indent<plain line=\"$line\">$plain</plain>"
				regsub {^[^§]+} $tex "" tex
			}

			# consume token
			if {[regexp {§(.+?)°} $tex dummy token]} {
				dump_xml_subtree $token
				regsub {§(.+?)°} $tex "" tex
			}
		}

		regsub "  " $dump_xml_indent "" dump_xml_indent
		puts "$dump_xml_indent</$type>"
	}
}


##
# Output syntax tree as xml
##
proc dump_xml { } {

	# reset indentation level
	global dump_xml_indent
	set    dump_xml_indent ""

	# output subtree beginning with the root node
	dump_xml_subtree content0
}


##################
## Main program ##
##################

assign_line_numbers

if {$config_out_tokens} { dump_tokens }
if {$config_out_xml}    { dump_xml }
if {$config_out_source} { dump_source }