#!/usr/bin/perl -I/usr/lib/kde1-compat/share/kdoc

# KDOC -- C++ and CORBA IDL interface documentation tool.
# Sirtaj Singh Kang <taj@kde.org>, Jan 1999.
# $Id: kdoc,v 1.16 1999/07/16 00:57:52 ssk Exp $

# All files in this project are distributed under the GNU General
# Public License. This is Free Software.

require 5.000;

use Carp;
use Getopt::Long;
use File::Basename;

use Ast;

use kdocUtil;
use kdocAstUtil;
use kdocParseDoc;

# globals

%rootNodes = ();			# root nodes for each file type
$declNodeType = undef;			# last declaration type

# All options

%options = ();				# hash of options (set getopt below)
$libdir = $ENV{KDOCLIBS};
$libname = "";
$outputdir = ".";
@libs = ();				# list of includes
$striphpath = 0;

$doPrivate = 0;
$Version = "2.0a12";

$quiet = 0;
$debug = 0;
$parseonly = 0;

$currentfile = "";
$exe = basename $0;

# these are for expansion of method flags

%flagnames = ( v => 'virtual', 's' => 'static', p => 'pure',
	c => 'const', l => 'slot', i => 'inline', n => 'signal' );
	

=head1 KDOC -- Source documentation tool 

	Sirtaj Singh Kang <taj@kde.org>, Dec 1998.

=cut

# read options

Getopt::Long::config qw( no_ignore_case permute bundling auto_abbrev );

$err = GetOptions( \%options, "html|H", 
	"latex|T", "man|M",  
	"texinfo|X",
	"url|u=s",
	 "skip-internal|i",
	"skip-deprecated|e", 
	"document-all|a",
	"compress|z",

	# HTML options
	"html-cols=i",
	"html-logo=s",
	
	"strip-h-path",	\$striphpath,
	"outputdir|d=s", \$outputdir,
	"name|n=s",	\$libname,
	"help|h", 	\&show_usage,
	"version|v|V", 	\&show_version,
	"private|p",	\$doPrivate,
	"libdir|L=s",	\$libdir, 
	"xref|l=s",	\@libs,

	"quiet|q",	\$quiet,
	"debug|D",	\$debug,
	"parse-only",	\$parseonly );

if ( $err == 0 ) {
	exit 1;
}

# work out libdir. This is created by kdocLib:writeDoc when
# required.
$libdir = $ENV{HOME}."/.kdoc" unless defined $libdir;

# HTML is the default
if( !exists $options{html} && !exists $options{latex} 
		&& !exists $options{man} && !exists $options{texinfo} ) {
	$options{html} = 1;
}

# read all libraries
if ( $#libs >= 0 ) {
	require kdocLib;
	foreach my $lib ( @libs ) {
		print "$exe: reading lib: $lib\n" unless $quiet;

		my $relpath = exists $options{url} ? $options{url} 
			: $outputdir;
		print "url: $options{url} outputdir: $outputdir, chose ",
			"$relpath\n";
		kdocLib::readLibrary( \&getRoot, $lib, $libdir,
			$relpath );
	}
}

# process files

die "$exe: no input files.\n" if $#ARGV < 0;

foreach $currentfile ( @ARGV ) {
	open( INPUT, "$currentfile" ) || croak "Can't read from $currentfile";
	print "$exe: processing $currentfile\n" unless $quiet;

	# reset vars
	if ( $currentfile =~ /\.idl\s*$/ ) {
		# IDL file
		$rootNode = getRoot( "IDL" );
	}
	else {
		# assume cxx file
		$rootNode = getRoot( "CXX" );
	}
	$classStack = ();
	$cNode = $rootNode;

	# parse
	do {
		$k = readDecl();

		if( defined $k ) {
			print "\nDecl: <$k>\n" if $debug;
			if( identifyDecl( $k ) && $k =~ /{/ ) {
				readCxxCodeBlock();
			}
		}

	} while( defined $k );
	close INPUT;
}


#kdocAstUtil::testRef( $rootNode );

if ( !$parseonly ) {

	foreach my $name ( keys %rootNodes ) {
		my $node = $rootNodes{ $name };
		kdocAstUtil::makeInherit( $node, $node );
		kdocAstUtil::linkReferences( $node, $node );

		if ( $name eq "CXX" ) {
			if ( exists $options{texinfo} ) {
				require kdoctexi;
				kdoctexi::writeDoc( $libname,
				$node, $outputdir, \%options );
			}
			if ( exists $options{html} ) {
				require kdocCxxHTML;
				kdocCxxHTML::writeDoc( $libname, $node, 
						$outputdir, \%options );
			}
		}
		elsif( $name eq "IDL" ) {
			if ( exists $options{texinfo} ) {
				warn "$exe: sorry, texinfo is not yet ".
					"supported for IDL\n";
			}
			if ( exists $options{html} ) {
				require kdocIDLhtml;
				kdocIDLhtml::writeDoc( $libname, $node,
					$outputdir, \%options );
			}
		}
	}

	# write libraries

	if( $libname ne "" ) {
		require kdocLib;
		foreach my $lang ( keys %rootNodes ) {
			my $node = $rootNodes{ $lang };
			kdocLib::writeDoc( $libname, $node, $lang, $libdir,
					$outputdir, $options{url},
					exists $options{compress} ? 1 : 0 );
		}
	}
}
else {
	print "\n\tParse Tree\n\t------------\n\n";
	kdocAstUtil::dumpAst( $rootNode );
}

kdocAstUtil::printDebugStats() if $debug;

#
# main ends
########################################################



=head2 readSourceLine

	Returns a raw line read from the current input file.
	This is used by routines outside main, since I don't know
	how to share fds.

=cut

sub readSourceLine
{
	return <INPUT>;
}

=head2 readCxxLine

	Reads a C++ source line, skipping comments, blank lines,
	preprocessor tokens and the Q_OBJECT macro

=cut

sub readCxxLine
{
	my( $p );
	my( $l );
	
	while( 1 ) {
		return undef if !defined ($p = <INPUT>);

		$p =~ s#//.*$##g;			# C++ comment
		$p =~ s#/\*(?!\*).*?\*/##g;		# C comment

		# join all multiline comments
		if( $p =~ m#/\*(?!\*)#s ) {
			# unterminated comment
LOOP:
			while( defined ($l = <INPUT>) ) {
				$l =~ s#//.*$##g;		# C++ comment
				$p .= $l;
				$p =~ s#/\*(?!\*).*?\*/##sg;	# C comment
				last LOOP unless $p =~ m#(/\*(?!\*))|(\*/)#sg;
			}
		}

		next if ( $p =~ /^\s*$/s 		# blank lines
			|| $p =~ /^\s*Q_OBJECT/		# QObject macro
			);

		# remove all preprocessor macros except #include
		next if( $p =~ /^\s*#\s*(\w+)/ );
		# {
		#	next if $1 ne "include";
		# }

		$lastLine = $p;

		return $p;
	}
}

=head2 readCxxCodeBlock

	Reads a C++ code block (recursive curlies), returning the last line
	or undef on error.

	Parameters: none

=cut

sub readCxxCodeBlock
{
# Code: begins in a {, ends in }\s*;?
# In between: cxx source, including {}
	my ( $count ) = 0;
	
	if ( defined $lastLine ) {
		print "lastLine: '$lastLine'" if $debug;

		my $open = kdocUtil::countReg( $lastLine, "{" );
		my $close = kdocUtil::countReg( $lastLine, "}" );
		$count = $open - $close;

		return $lastLine if ( $open || $close) && $count == 0;
	}

	# find opening brace
	if ( $count == 0 ) {
		while( $count == 0 ) {
			$l = readCxxLine();
			return undef if !defined $l;
			$l =~ s/".*?"//g;

			$count += kdocUtil::countReg( $l, "{" );
			print "c ", $count, " at '$l'" if $debug;
		}
		$count -= kdocUtil::countReg( $l, "}" );
	}

	# find associated closing brace
	while ( $count > 0 ) {
		$l = readCxxLine();
		croak "Confused by unmatched braces" if !defined $l;
		$l =~ s/".*?"//g;

		$add = kdocUtil::countReg( $l, "{" );
		$sub = kdocUtil::countReg( $l, "}" );
		$count += $add - $sub;

		print "o ", $add, " c ", $sub, " at '$l'" if $debug;
	}

	undef $lastLine;
	return $l;
}

=head2 readDecl

	Returns a declaration and sets the $lastNodeType variable.

	A decl starts with a type or keyword and ends with a ; or {
	The entire decl is returned in a single line, sans newlines.

	lastNodeType values: undef for error, "a" for access specifier,
	"c" for doc comment, "d" for other decls.

	readCxxLine is used to read the declaration.

=cut

sub readDecl
{
	undef $declNodeType;
	my $l = readCxxLine();
	my ( $decl ) = "";

	if( !defined $l ) {
		return undef;
	}
	elsif ( $l =~ /^\s*(private|public|protected|signals)
		(\s+\w+)?\s*:/x ) { # access specifier
		$declNodeType = "a";

		return $l;
	}
	elsif ( $l =~ m#^\s*/\*\*# ) {	# doc comment
		$declNodeType = "c";
		return $l;
	}

	do {
		$decl .= $l;

		if ( $l =~ /[{;]/ ) {
			$decl =~ s/\n/ /gs;
			$declNodeType = "d";
			return $decl;
		}
		return undef if !defined ($l = readCxxLine());

	} while ( 1 );
}

=head2 identifyDecl

	Parameters: decl

	Identifies a declaration returned by readDecl. If a code block
	needs to be skipped, this subroutine returns a 1, or 0 otherwise.

=cut

sub identifyDecl
{
	my( $decl ) = @_;

	my $newNode = undef;
	my $skipBlock = 0;

	# Doc comment
	if ( $declNodeType eq "c" ) {
		$docNode = kdocParseDoc::newDocComment( $decl );

	}
	elsif ( $declNodeType eq "a" ) {
		newAccess( $decl );
	}

	elsif ( $decl =~ /^\s*typedef\s+(struct|union|class|enum)\s*/ ) {
		warn "typedef '$1' at $currentfile:$.\n";
		$skipBlock = 1;
	}

	# Typedef
	elsif ( $decl =~ /^\s*typedef\s+
			(.*?\s*[\*&]?)		# type
			\s*([-\w_\:]+)		# name
			\s*[{;]\s*$/xs  ) {

		print "Typedef: <$1> <$2>\n" if $debug;
		$newNode = newTypedef( $1, $2 );
	}

	# Enum
	elsif ( $decl =~ /^\s*enum(\s+[-\w_:]*)?\s*\{(.*)/s  ) {

		print "Enum: <$1>\n" if $debug;
		my $enumname = defined $2 ? $1 : "";

		$newNode = newEnum( $enumname );
	}

	# Class/Struct
	elsif ( $decl =~ /^\s*(template\s*<(.*)>)?	# template
			\s*(class|struct|union) 	# struct type
			\s+([-\w_]+)			# name
			(.*?)				# inheritance?
			[;{]/xs ) {

		print "Class: [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n" if $debug;

		my ( $tfull, $targs, $ntype, $name, $rest ) =
			( $1, $2, $3, $4, $5 );
		my @inherits = ();

		if(  $rest =~ /^\s*:\s*/ ) {
			$rest = $';
			@inherits = split /\s*,\s*/, $rest;

			if ( $debug ) {
				foreach $rest ( @inherits ) {
					print "Inherits: $rest\n" 
				}
			}
		}

		$newNode = newClass( $decl, $tfull, $targs, $ntype, 
			$name, @inherits );
	}
	# IDL compound node
	elsif( $decl =~ /^\s*(module|interface|exception) # struct type
			\s+([-\w_]+)			# name
			(.*?)				# inheritance?
			([;{])/xs ) {
		
		my ( $type, $name, $rest, $fwd, $complete ) 
			= ( $1, $2, $3, $4 eq ";" ? 1 : 0,
				0 );
		my @in = ();
		print "IDL: [$type] [$name] [$rest] [$fwd]\n" if $debug;

		if( $rest =~ /^\s*:\s*/ ) {
			$rest = $';
			$rest =~ s/\s+//g;
			@in = split ",", $rest;
		}
		if( $decl =~ /}\s*;/ ) {
			$complete = 1;
		}

		$newNode = newIDLstruct( $type, $name, $fwd, $complete, @in );
	}
	# Method
	elsif ( $decl =~ /^\s*(.+?) 	# return type + name
		\( (.*?) \)		# parameters
		(.*?)[;{]+/xs ) {	# rest

		print "Method: [$1]\n\t[$2]\n\t[$3]\n" if $debug;

		my $tpn = $1; # type + name
		my $params = $2;
		my $rest = $3;

		my $const = 0;
		if( $rest =~ /const/ ) {
			$const = 1;
		}

		my $pure = 0;
		if ( $rest =~ /=\s*0/ ) {
			$pure = 1;
		}

		if ( $tpn =~ /((:?\S+::)?operator.*?)\s*$/ 	 # operator
				|| $tpn =~ /(~?[-\w:]+)\s*$/ ) { # normal
			
			$name = $1;
			$tpn = $`;
			$newNode = newMethod( $tpn, $name, 
					$params, $const, $pure );
		}

		$skipBlock = 1;
	}

	# Variable
	elsif ( $decl =~ /^\s*(?:[\w_:<>]\s*)+ # type
			[\&\s\*]*	# ptr or ref
			[\w_\[\]\s]+	# name
			(?:\=.*)?	# value
			\s*[;{]/xs ) {
		# TODO FIXME: Assuming everything is a variable.

		my $val = undef;

		if ( $decl =~ /=(.*?)\s*[;{]/ ) {
			# store and remove value
			$val = $1;
			$decl =~ s/=.*([;{])/$1/;
		}

		if( $decl =~ /^(.*)([\s&\*]+)\s* # type
				([\w:_\s]+)	# name
				\s*((?:\[.*\])?) # array
				\s*([;{])\s*$/xs ) {	# end
			my $var = $3;
			my $rest = $1.$2.$4;
			$rest =~ s/\s+$//g;

			print "Var: [$var] type: [$rest] val: [$val]\n" 
				if $debug;

			$newNode = newVar( $rest, $var, $val );

			$skipBlock = 1 if $decl =~ /{\s*$/;
		}
		else {
			carp "Type match: failed with $decl\n";
		}

	}
	# end of an in-block declaration
	elsif ( $decl =~ /}\s*(.*?);/ ) {

		if ( $#classStack < 0 ) {
			confess "close decl found, but no class in stack!" ;
			$cNode = $rootNode;
		}
		else {
			$cNode = pop @classStack;
			print "end decl: popped $cNode->{astNodeName}\n" 
				if $debug;
		}
	}

	# unidentified block start
	elsif ( $decl =~ /{/ ) {
		print "Unidentified block start: $decl\n" if $debug;
		$skipBlock = 1;
	}
	else {

		## decl is unidentified.
		warn "Unidentified decl: $decl\n";
	}

	# once we get here, the last doc node is already used.
	if( defined $newNode ) {

		$newNode->AddProp( "Source", $currentfile )
			unless $newNode->{NodeType} eq "Forward";

		if ( defined $docNode ) {
			$newNode->AddProp( "DocNode", $docNode );
			$newNode->AddProp( "Internal", 1 ) 
				if defined $docNode->{Internal};
			$newNode->AddProp( "Deprecated", 1 ) 
				if defined $docNode->{Deprecated};

			undef $docNode;
		}
	}

	return $skipBlock;
}

=head2 newEnum

	Reads the parameters of an enumeration.

	Returns the parameters, or undef on error.

=cut

sub newEnum
{
	my ( $enum ) = @_;
	my $k = undef;
	my $params = "";

	$k = $lastLine if defined $lastLine;

	if( defined $lastLine && $lastLine =~ /{/ ) {
		$params = $';
		if ( $lastLine =~ /}(.*?);/ ) {
			return initEnum( $enum, $1, $params );
		}
	}

	while ( defined ( $k = readCxxLine() ) ) {
		$params .= $k;

		if ( $k =~ /}(.*?);/ ) {
			return initEnum( $enum, $1, $params );
		}
	}

	return undef;
}

=head3 initEnum

	Parameters: name, (ref) params

	Returns an initialized enum node.

=cut

sub initEnum
{
	my( $name, $end, $params ) = @_;

	($name = $end) if $name eq "" && $end ne "";

	$params =~ s#\s+# #sg; # no newlines
	$params = $1 if $params =~ /^\s*{?(.*)}/;
	print "$name params: [$params]\n" if $debug;


	my ( $node ) = Ast::New( $name );
	$node->AddProp( "NodeType", "enum" );
	$node->AddProp( "Params", $params );
	kdocAstUtil::attachChild( $cNode, $node );

	return $node;
}

=head2 newIDLstruct

	Parameters: type, name, forward, complete, inherits...

	Handles an IDL structure definition (ie module, interface,
	exception).

=cut

sub newIDLstruct
{
	my ( $type, $name, $fwd, $complete ) = @_;

	my $node = exists $cNode->{KidHash} ? 
		$cNode->{KidHash}->{ $name } : undef;

	if( !defined $node ) {
		$node = Ast::New( $name );
		$node->AddProp( "NodeType", $fwd ? "Forward" : $type );
		$node->AddProp( "KidAccess", "public" );
		$node->AddProp( "Compound", 1 ) unless $fwd;
		kdocAstUtil::attachChild( $cNode, $node );
	}
	elsif ( $fwd ) {
		# If we have a node already, we ignore forwards.
		return undef;
	}
	elsif ( $node->{NodeType} eq "Forward" ) {
		# we are defining a previously forward node.
		$node->AddProp( "NodeType", $type );
		$node->AddProp( "Compound", 1 );
	}

	# register ancestors.
	foreach my $ances ( splice ( @_, 4 ) ) {
		my $n = kdocAstUtil::newInherit( $node, $ances );
	}

	if( !( $fwd || $complete) ) {
		print "newIDL: pushing $cNode->{astNodeName},",
			" new is $node->{astNodeName}\n"
				if $debug;
		push @classStack, $cNode;
		$cNode = $node;
	}

	return $node;
}

=head2 newClass

	Parameters: decl, tmplFull, tmplArgs, cNodeType, name, @inheritlist

	Handles a class declaration (also fwd decls).

=cut

sub newClass
{
	my( $decl, $tmplFull, $tmplArgs,
		$cNodeType, $name ) = @_;

	my $access = "private";
	$access = "public" if $cNodeType ne "class";

	# try to find an exisiting node, or create a new one
	my $oldnode = kdocAstUtil::findRef( $cNode, $name );
	my $node = undef;
	my $node = defined $oldnode ? $oldnode : Ast::New( $name );

	unless ( $decl =~ /{/ ) {
		# forward
		if ( !defined $oldnode ) {
			# new forward node
			$node->AddProp( "NodeType", "Forward" );
			$node->AddProp( "KidAccess", $access );
			kdocAstUtil::attachChild( $cNode, $node );
		}
		return $node;
	}

	# this is a class declaration

	print "ClassName: $name\n" if $debug;

	$node->AddProp( "NodeType", $cNodeType );
	$node->AddProp( "Compound", 1 );

	$node->AddProp( "KidAccess", $access );
	$node->AddProp( "Tmpl", $tmplArgs ) unless !defined $tmplArgs;

	if ( !defined $oldnode ) {
		kdocAstUtil::attachChild( $cNode, $node );
	}

	# inheritance

	foreach my $ances ( splice (@_, 5) ) {
		my $type = "";
		my $name = $ances;
		my $intmpl = undef;

WORD:
		foreach my $word ( split ( /([\w:]+(:?\s*<.*>)?)/, $ances ) ) {
			next WORD unless $word =~ /^[\w:]/;
			if ( $word =~ /(private|public|protected|virtual)/ ) {
				$type .= "$1 ";
			}
			else {
				
				if ( $word =~ /<(.*)>/ ) {
					# FIXME: Handle multiple tmpl args
					$name = $`;
					$intmpl = $1;
				}
				else {
					$name = $word;
				}

				last WORD;
			}
		}
		
		chop $type unless $type eq "";
		my $n = kdocAstUtil::newInherit( $node, $name );
		$n->AddProp( "Type", $type );

		$n->AddProp( "TmplType", $intmpl ) if defined $intmpl;
	}

	# new current node
	print "newClass: Pushing $cNode->{astNodeName}\n" if $debug;
	push ( @classStack, $cNode );
	$cNode = $node;

	return $node;
}

=head2 newTypedef

	Parameters: realtype, name

	Handles a type definition.

=cut

sub newTypedef
{
	my ( $realtype, $name ) = @_;

	my ( $node ) = Ast::New( $name );

	$node->AddProp( "NodeType", "typedef" );
	$node->AddProp( "Type", $realtype );

	kdocAstUtil::attachChild( $cNode, $node );

	return $node;
}

=head2 newMethod

	Parameters: retType, name, params, const, pure?

	Handles a new method declaration or definition.

=cut

sub newMethod
{
	my ( $retType, $name, $params, $const, $pure ) = @_;
	my $parent = $cNode;
	my $class;

	print "Cracked: [$retType] [$name]\n\t[$params]\n\t[$const]\n" 
		if $debug;

	if ( $retType =~ /([\w\s_<>]+)\s*::\s*$/ ) {
		# check if stuff before :: got into rettype by mistake.
		$retType = $`;
		($name = $1."::".$name);
		$name =~ s/\s+//g;
		print "New name = \"$name\" and type = '$retType'\n";
	}

	if( $name =~ /^\s*(.*?)\s*::\s*(.*?)\s*$/ ) {
		# Fully qualified method name.
		$name = $2;
		$class = $1;

		if( $class =~ /^\s*$/ ) {
			$parent = $rootNode;
		}
		elsif ( $class eq $cNode->{astNodeName} ) {
			$parent = $cNode;
		}
		else {
			my $node = kdocAstUtil::findRef( $cNode, $class );

			if ( !defined $node ) {
				warn "$exe: Unidentified class: $class ".
					"in $currentfile\:$.\n";
				return undef;
			}

			$parent = $node;
		}
	}
	else {
		# Within current class/global
	}


	# flags

	my $flags = "";

	if( $retType =~ /static/ ) {
		$flags .= "s";
		$retType =~ s/static//g;
	}

	if( $const ) {
		$flags .= "c";
	}

	if( $pure ) {
		$flags .= "p";
	}

	if( $retType =~ /virtual/ ) {
		$flags .= "v";
		$retType =~ s/virtual//g;
	}

	print "\n" if $flags ne "" && $debug;

	if ( !defined $parent->{KidAccess} ) {
		warn "'", $parent->{astNodeName}, "' has no KidAccess ",
		exists $parent->{Forward} ? "(forward)\n" :"\n";
	}

	if ( $parent->{KidAccess} =~ /slot/ ) {
		$flags .= "l";
	}
	elsif ( $parent->{KidAccess} =~ /signal/ ) {
		$flags .= "n";
	}

	# node
	
	my $node = Ast::New( $name );
	$node->AddProp( "NodeType", "method" );
	$node->AddProp( "Flags", $flags );
	$node->AddProp( "ReturnType", $retType );
	$node->AddProp( "Params", $params );

	$parent->AddProp( "Pure", 1 ) if $pure;
	kdocAstUtil::attachChild( $parent, $node );

	return $node;
}

=head2 newAccess

	Parameters: access

	Sets the default "Access" specifier for the current class node. If
	the access is a "slot" type, "_slots" is appended to the access
	string.

=cut

sub newAccess
{
	my ( $access ) = @_;

	return undef unless ($access =~ /^\s*(\w+)\s*(slots)?/);

	print "Access: [$1] [$2]\n" if $debug;

	$access = $1;

	if ( defined $2 && $2 ne "" ) {
		$access .= "_" . $2;
	}

	$cNode->AddProp( "KidAccess", $access );

	return $cNode;
}

=head2 newVar

	Parameters: type, name, value

	New variable. Value is ignored if undef

=cut

sub newVar
{
	my ( $type, $name, $val ) = @_;

	my $node = Ast::New( $name );
	$node->AddProp( "NodeType", "var" );

	my $static = 0;
	if ( $type =~ /static/ ) {
		$type =~ s/static//;
		$static = 1;
	}

	$node->AddProp( "Type", $type );
	$node->AddProp( "Static", $static );
	$node->AddProp( "Value", $val ) if defined $val;
	kdocAstUtil::attachChild( $cNode, $node );

	return $node;
}



=head2 show_usage

	Display usage information and quit.

=cut

sub show_usage
{
print<<EOF;
usage:
	$exe [options] [-d outdir] [-n name] files... [-llib..]

See the man page kdoc[1] for more info.
EOF
	exit 1;
}


=head2 show_version

	Display short version information and quit.

=cut

sub show_version
{
	die "kdoc: $Version (c) Sirtaj S. Kang <taj\@kde.org>\n";
}

=head2 getRoot

	Return a root node for the given type of input file.

=cut

sub getRoot
{
	my $type = shift;
	carp "getRoot called without type" unless defined $type;

	if ( !exists $rootNodes{ $type } ) {
		my $node = Ast::New( "Global" );	# parent of all nodes
		$node->AddProp( "NodeType", "root" );
		$node->AddProp( "RootType", $type );
		$node->AddProp( "Compound", 1 );
		$node->AddProp( "KidAccess", "public" );

		$rootNodes{ $type } = $node;
	}
	print "getRoot: call for $type\n" if $debug;

	return $rootNodes{ $type };
}

