#! /usr/bin/perl -w
# -*- perl -*-

#
# Please find extensive documentation of this program at
# <http://os.inf.tu-dresden.de/~hohmuth/prj/preprocess/>
#

# Things this script does:
#
# - Expand class declarations as necessary using member-function
#   definitions found in the file.  Function labelled PUBLIC,
#   PROTECTED and PRIVATE are put into the corresponding section of
#   the class.
#
# - Put "INTERFACE:" regions in public header file.
#
# - Put "inline" functions and all types they need into public header
#   file as well.
#
# - Put all remaining, private types and their inline functions into a
#   separate header file.  This file can be used by a debugger
#   interface to display the data.
#
# - Place include directives to top of public header file and private
#   header file.
#

#
# Declarations
#

require 5.006;
use Getopt::Std;
sub print_expand($);
sub print_funcdecl($);
sub print_funcdef($);
sub print_classdecl($);
sub print_code($);
sub func_prototype($);

#
# Get options
#

$opt_c = '';			# Base name for generated include directives
$opt_o = '';			# Base name of output files (defaults to -c, 
				# overrides -p)
$opt_p = '';			# Prepend to base name of output files (-c)
$opt_h = '';			# Name of public header; overrides -c
$opt_i = 0;			# Doing inlines?
$opt_v = 0;			# Verboseness?
$opt_l = 0;			# Avoid generating #line directives?
$opt_L = 0;			# Avoid generatung #line dirs in headers only?

# Added 2003.01.12  by RCB
# Support for changing the names of headers
$opt_H = "h";			# Default extenstion for header files
$opt_C = "cc";			# Default extention for source files

getopts('o:c:p:h:H:C:ivlL');

die "Need to specify option -c Classfile_basename;" if $opt_c eq '';
$incfile_base = $opt_c;
$public_base = (($opt_h eq '') ? $incfile_base : $opt_h);

if ($opt_o eq '')
  {
    $outfile_base = $opt_p . $incfile_base;
    $headerfile_base = $opt_p . $public_base;
  }
else
  {
    $outfile_base = $opt_o;
    $headerfile_base = $outfile_base;
  }

$doing_inlines = $opt_i;
$verbose = $opt_v;

$doing_linenumbers = (! $opt_l) && (! $opt_L);

# Added 2003.01.12  by RCB
# Support for changing the names of headers
$source_ext = $opt_C;
$header_ext = $opt_H;

# 
# Variable initializations
#
parse_init();

$print_indent = 0;
clear_head();

%classes = ();
%sections = ();
%impl_parts = ();
%includes = ();
@comments = ();

# 
# Parse input file
#

parse_file ();

#
# Print header file
# 

# Fixup incfile_base preproc macro if it contains invalid chars.
$incfile_base_macro = $incfile_base;
$incfile_base_macro =~ s/[+-]/_/g;

open OUT, ">${headerfile_base}.$header_ext";
print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
print OUT "#ifndef ${incfile_base_macro}_$header_ext\n" .
          "#define ${incfile_base_macro}_$header_ext\n";

%public_inline = ();
%private_inline = ();
@inline_order = ();

foreach $i (grep {$_->{type} eq 'include'} @{$sections{"INTERFACE"}})
  {
    print_code $i;
  }

print_head ("\n" .
	    "//\n" .
	    "// INTERFACE definition follows \n" .
	    "//\n\n");

foreach $i ( (grep {$_->{type} eq 'classdef' && $_->{syntax} eq 'forwarddecl'}
	           @{$sections{"INTERFACE"}}),
	     (grep {$_->{type} ne 'classdef' || $_->{syntax} ne 'forwarddecl'}
	           @{$sections{"INTERFACE"}}) )
  {
    if ($i->{type} eq 'code')
      {
	print_code $i;
      }
    elsif ($i->{type} eq 'classdef')
      {
	print_classdecl ($i);
      }
  }

foreach $i (grep {$_->{type} eq 'function' && $_->{class} eq ''
		                           && ! $_->{static}} 
	         @{$sections{"IMPLEMENTATION"}})
  {
    print_funcdecl $i;
  }

@public_templates = grep 
  {
    $_->{type} eq 'function' && $_->{template} ne '' # template func
    && $_->{fully_specialized_template} eq ''
    && ! defined $public_inline{$_} # not public inline -- handled elsewhere
    && (($_->{class} eq '' && $_->{visibility} eq "public") # free func
	|| ($_->{class} ne ''	# or member func of public or published class
	    && ($classes{$_->{class}}->{section} eq 'INTERFACE'
		|| defined $public_inline{$classes{$_->{class}}})))
  } 
		    @{$sections{"IMPLEMENTATION"}};

$impl_includes_imported = 0;

if (($doing_inlines && scalar keys %public_inline)
    || scalar @public_templates)
  {
    if (scalar @public_templates)
      {
	$impl_includes_imported = 1;
      }

    clear_head();
    print_head 
      ("\n" .
       "//\n" .
       "// IMPLEMENTATION includes follow (for use by inline functions)\n" .
       "//\n\n");

    foreach $i (grep { $_->{type} eq 'include' && ($impl_includes_imported
						   || $_->{inline}) }
		     @{$sections{"IMPLEMENTATION"}})
      {
	print_code $i;
      }

    clear_head();
    print_head 
      ("\n" . 
       "//\n" .
       "// IMPLEMENTATION of inline functions (and needed classes)\n" .
       "//\n\n");
    print_inlines (grep {defined $public_inline{$_}} 
		        @inline_order);

    @inline_order = grep {! defined $public_inline{$_}} 
                         @inline_order;
  }

clear_head();
print_head ("\n" .
	    "//\n" .
	    "// IMPLEMENTATION of function templates\n" .
	    "//\n\n");
foreach $i (@public_templates)
  {
    print_funcdef $i;
  }

clear_head();

print OUT "\n#endif // ${incfile_base_macro}_$header_ext\n";
close OUT;

#
# Print "internal data structures" header file
#

open OUT, ">${outfile_base}_i.$header_ext";
print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
print OUT "#ifndef ${incfile_base_macro}_i_$header_ext\n" .
          "#define ${incfile_base_macro}_i_$header_ext\n";

if (! $impl_includes_imported)
  {
    foreach $i (grep { $_->{type} eq 'include' && ! $_->{inline} }
		     @{$sections{"IMPLEMENTATION"}})
      {
	print_code $i;
      }
  }

foreach $i ( (grep {$_->{type} eq 'classdef' && $_->{syntax} eq 'forwarddecl'}
	           @{$sections{"IMPLEMENTATION"}}),
	     (grep {$_->{type} eq 'classdef' && $_->{syntax} ne 'forwarddecl'}
	           @{$sections{"IMPLEMENTATION"}}) )
  {
    if ($doing_inlines)
      {
	next if defined $public_inline{$i};
      }
    
    print_classdecl ($i);
    
    if ($doing_inlines)
      {	    
	my $name = $i->{name};
	# Avoid printing this declaration again.
	@inline_order = grep {$_->{name} !~ /^$name$/ } @inline_order;
      }
  }


# XXX should we print #defines here?

if ($doing_inlines)
  {
    my @inlines = grep { ! (defined $_->{hide} && $_->{hide}) } @inline_order;
#   @inline_order = grep { (defined $_->{hide} && $_->{hide}) } @inline_order;

#   my @inlines = @inline_order;
    @inline_order = ();

    print_head ("\n" . 
		"//\n" .
		"// IMPLEMENTATION of inline functions follows\n".
		"//\n\n");
    print_inlines (@inlines);
  }

clear_head();
print_head ("\n" .
	    "//\n" .
	    "// IMPLEMENTATION of function templates\n" .
	    "//\n\n");
foreach $i (grep 
	      {
		$_->{type} eq 'function' && $_->{template} ne ''
		&& $_->{fully_specialized_template} eq ''
		&& ! defined $public_inline{$_}
		&& ! defined $private_inline{$_}
		&& (($_->{class} eq '' && $_->{visibility} ne 'public')
		    || ($_->{class} ne '' 
			&& ($classes{$_->{class}}->{section} ne 'INTERFACE' &&
			    !defined $public_inline{$classes{$_->{class}}})))
	      } @{$sections{"IMPLEMENTATION"}})
  {
    print_funcdef $i;
  }

clear_head();

print OUT "\n#endif // ${incfile_base_macro}_i_$header_ext\n";
close OUT;

$doing_linenumbers = (! $opt_l);

#
# Print implementation file(s)
#

foreach my $part (keys %impl_parts)
  {
    
    open OUT, ">${outfile_base}" . ($part eq '' ? "" : ("-" . $part)) . ".$source_ext";
    print OUT "// AUTOMATICALLY GENERATED -- DO NOT EDIT!         -*- c++ -*-\n\n";
    print OUT "#include \"${public_base}.$header_ext\"\n" .
              "#include \"${incfile_base}_i.$header_ext\"\n\n";

    foreach $i (grep {$_->{type} eq 'function' && $_->{class} eq ''
			&& $_->{static}} 
		     grep {$_->{part} eq $part} @{$sections{"IMPLEMENTATION"}})
      {
	print_funcdecl $i;
      }
    
    if ($doing_inlines)
      {
	print_inlines (grep {$_->{part} eq $part} @inline_order);
      }
    
    foreach $i (grep {$_->{part} eq $part} @{$sections{"IMPLEMENTATION"}})
      {
	if ($i->{type} eq 'code')
	  {
	    print_code $i;
	  }
	elsif ($i->{type} eq 'function')
	  {
	    if ($doing_inlines)
	      {
		next if $i->{inline} && ! $i->{hide};
	      }
	    
	    next if $i->{template} ne ''
		    && $i->{fully_specialized_template} eq '';
	    
	    print_funcdef $i;
	  }
      }
  }

close OUT;


exit 0;

#############################################################################

#
# Parser code.
#

sub parse_init			# Initialize parser variables.
{
  # Regexp for whitespace; the \001 stuff is for comments
  $s_once = '(?:[\n\s]|\001[0-9]+\001)';

  # Zero or more whitespace
  $s = $s_once . '*';

  # Identifier
  $identifier = "(?:[A-Za-z_][A-Za-z_0-9]*)";

  # Template declaration tag
  $template = "template$s<(?:[A-Za-z_0-9<>,]|$s_once)*>$s";

  # Template argument list
  $template_arg = "<(?:[A-Za-z_0-9<>,]|$s_once)*>";

  # Operator name
  $operator_name = "(?:operator$s(?:(?:".'[=\-\+\*<>]'."*)|$identifier)$s)";
}

sub parse_file  
{
  $lineno = 0;
  @ifstack = ();

  $current_section = "IMPLEMENTATION";
  $current_part = "";
  
 NEXTLINE:  
  while (1)
    {
#print "PARSED: $_\n";
      $_ = '';
      $blockstart = $lineno + 1;
      $blockfile = $ARGV;

    MORE: 
      while (1)
	{
	  if (! read_more())
	    {
	      last NEXTLINE;
	    }
	  
	  if (/^$s\/\/-[\s\n]*$/s)
	    {
	      handle_source_code ();
	      next NEXTLINE;	      
	    }

	  if (s/^($s)
	        (?:(INTERFACE
		    | IMPLEMENTATION) 
		      (?:$s \[ $s ([A-Za-z0-9_-]+) $s \] $s)? : )
	       /$1/sx)
	    {
	      $current_section = $2;
	      if ($current_section eq "IMPLEMENTATION")
		{
		  if (defined $3)
		    {
		      $current_part = $3;
		    }
		  else
		    {
		      $current_part = '';
		    }
		}
	      else 
		{
		  if (defined $3 && $opt_h ne $3) 
		    {
		      die "${ARGV}:${lineno}: all INTERFACE arguments and "
			. "option -h must be consistent;"
			  if ($opt_h ne '');

		      $public_base = $3;
		      $opt_h = $3;
		      if ($opt_o eq '')
			{
			  $headerfile_base = $opt_p . $public_base
			}
		    }  
		}
	      handle_source_code ();
	      next NEXTLINE;
	    }
	  
	  # Preprocessor directive?
	  if (/^$s\#/s)
	    {
	      while (/\\\n$/s)
		{
		  last NEXTLINE if ! read_more();
		}

	      handle_preproc();
	      next NEXTLINE;
	    }
	  
	  next NEXTLINE if ignoring();

	  # Read until we can decide what we have: Read till next block end
	  # or semicolon.
	  if (/\{/)
	    {
	      # Have a block.
	      my $foo = $_;
	      do {} while ($foo =~ s/\{[^\{\}]*\}//sg); # kill blocks
	      if ($foo =~ /\{/)
		{
#print "MORE: $foo\n";
		  next MORE;	# Still unfinished blocks.
		}
	    }
	  elsif (! /;/) # no unclosed blocks & semicolon?
	    {
	      next MORE;
	    }
	  
	  # Type declaration?
	  if (/^$s(?:$template)?(enum|struct|class|typedef)/s)
	    {
	      my $syntax = $1;

	      if (/^$s(?:$template)?
		    (?:enum|struct|class)
		    $s ($identifier (?:$s $template_arg)?)
		    $s (?::(?!:)|\{)/sx)
		{
		  # Have a block -> this is a definition.
		  
		  my $name = $1;
		  
		  if (/^(.*)(\}.*)$/s) 
		    {
		      $class = { name => $name,
				 syntax => $syntax,
				 pretext => $1,
				 posttext => $2 };
#print "CLASS " . $class->{name} . ">" .$class->{pretext} . "###" . $class->{posttext};		    
		      handle_classdef ($class);
		    }
		}
	      else 
		{
		  # No block or no name -- handle as declaration.
		  if (/^$s(?:$template)?(?:enum|struct|class)$s\{/s)
		    {
		      # no name but block -- make this a global variable decl.
		      handle_source_code ();
		    }
		  elsif (/^$s(?:$template)?(?:enum|struct|class)/s)
		    {
		      # no block -- this seems to be a forward
		      # decl. or a variable decl.

		      if (/^$s(?:$template)?(?:enum|struct|class)$s
			  ($identifier) $s ;/sx)
			{
			  $class = { syntax => 'forwarddecl',
				     name => $1 };
			  handle_classdef ($class);
			}
		      else
			{
			  handle_source_code ();
			}
		    }
		  elsif (/^${s}typedef.*($identifier)$s(?:\([^\)]*\)(?:${s}const)?)?$s;$s$/s)
		    {
		      # It's a typedef;
		      $class = { syntax => 'typedef',
				 name => $1 };
		      handle_classdef ($class);
		    }
		  else
		    {
		      die "${ARGV}:$lineno: Parse error";
		    }
		}
	      
	      next NEXTLINE;
	    }
	  
	  # Type declaration extension?
	  if (/^$s EXTENSION $s (?:struct|class) $s ($identifier) 
	       $s \{ (.*) \} $s ; $s $/sx)
	    {
	      my $name = $1;
	      my $string = $2;

	      if (! exists $classes{$name})
		{
		  die "${ARGV}:$lineno: Class extension for undefined class " .
		      $name;
		}

	      # XXX XXX we should not handle line directives here --
	      # this is the job of the output functions.  However, as
	      # we don't generate a new codechunk for this extension,
	      # we just add the extension's line number here.

	      if ($doing_linenumbers)
		{
		  $classes{$name}->{pretext} .= 
		    "\n#line " . $blockstart . " \"" . $ARGV . "\"\n";
		}

	      $classes{$name}->{pretext} .= "private:\n" . $string;

	      next NEXTLINE;
	    }
  

	  # Member function definition?
	  if (/^([^\{\(]*)              # pretext, maybe w template decl tag
	       \b ($identifier)	        # class name
	       ($s $template_arg)?      # optional class-template args
	       $s :: $s
	       ((?:$operator_name | (?: ~? $identifier )) # member name
	        (?:$s $template_arg)?)  # optional member-template args
               $s ( \( (?: [^\)] | \([^\)]*\) )* \) [^:\{\(=]* ) # arg list
               ((?:\{|:.*\{).*)$/sx)    # initializer ':' and body '{'
	    {
	      $memberfunction = { class => $2,
				  name => $4,
				  templateargs => (defined $3
						   ? $3 : ''),
				  pretext => $1,
				  args => $5,
				  posttext => $6 };
	      handle_function ($memberfunction);
	      next NEXTLINE;
	    }
	  
	  # Free function definition?
	  if (/^([^\{]*)                # pretext, maybe w template decl tag
               \b ($operator_name | $identifier) # function name
	       ($s $template_arg)?      # optional template args
               $s( \( (?: [^\)] | \([^\)]*\) )* \) [^:\{\(=]*) # arg list
               (\{.*)$/sx)              # body
	    {
	      $function = { class => '',
			    name => $2,
			    templateargs => (defined $3
					     ? $3 : ''),
			    pretext => $1,
			    args => $4,
			    posttext => $5 };
	      handle_function ($function);
	      next NEXTLINE;
	    }
	  
	  handle_source_code ();
	  next NEXTLINE;
	}
    }

  if (! /^$s$/s)
    {
      $verbose && print "EOF: " . $_ . "\n";
      die "${blockfile}:$blockstart: Unexpected end of file in block starting here;";
    }

}

sub read_more ()	# Read one more line of code. Stow away
                        # comments and character constants
{
  # Get a line without comments.
  while (1)
    {
      if (eof)			# Reset line numbering.
	{
	  $lineno = 0;
	}

      $lineno++;

      my $line = <>;

      if (! defined $line)
	{
	  return 0;
	}

      $_ .= $line;

      # Save comments in @comments array.
      my $number = @comments;
      while (s|(//(?!-\s*\n).*)$|\001$number\001|m) # Do not match magic "//-"
	{			# The \001 signifies whitespace.
	  push @comments, $1;
	  $number++;
	}

      while (s|(/\*.*\*/)|\001$number\001|s)
	{
	  push @comments, $1;
	  $number++;
	}
      
      # We don't touch strings in NEEDS[], neither #includes!  Save now --
      # restore later.
      my $saved = '';
      if (s/(^$s \# $s include.*$
	     | NEEDS $s \[[^\]]* )
	   /\003/sx)
	{
	  $saved = $1;
	}

      while (s,(\'(?:\\.|[^\']|\\[0-7]+)\'),\002$number\002,s)
	{
	  push @comments, $1;
	  $number++;
	}

#      while (s,(\"(?:[^\"]|(?<=\\)\")*\"),\002$number\002,s)
      while (s,(\"(?:[^\\\"]|\\.)*\"),\002$number\002,s)
	{
	  push @comments, $1;
	  $number++;
	}

      if ($saved ne '')
	{
	  s/\003/$saved/s;
	}

      if (! /\/\*/)
	{
	  last;
	}
    }

  return 1;
}

sub label_chunk
{
  my ($codechunk,$type) = @_;

  $codechunk->{type} = $type;
  $codechunk->{section} = $current_section;
  $codechunk->{string} = $_;
  $codechunk->{part} = $current_part;
  $impl_parts{$current_part} = 1;

  $codechunk->{line} = $blockstart;
  $codechunk->{file} = $ARGV;

  push @{$sections{$current_section}}, $codechunk;
}

sub ignoring
{
  foreach my $i (@ifstack)
    {
      if ($i == 1)
	{
	  return 1;
	}
    }

  return 0;
}

sub handle_preproc 
{
#   if ($codeblock->{string} =~ /^$s\#\s*(if|endif|else|elif)/)
#     {
#       die "${ARGV}:${lineno}: Conditional compilation not supported;";
#     }

  if (/^$s\#\s*if\s+0${s}$/)
    {
      push @ifstack, 1;
      $verbose && print "IF 0: " . ignoring() . "\n";
      return;
    }
  elsif (@ifstack && /^$s\#\s*if(def|ndef)?\s/)
    {
      push @ifstack, 0;
      $verbose && print "IF: " . ignoring() . "\n";
      return if ignoring();
    }
  elsif (@ifstack && /^$s\#\s*(else|elif)/)
    {
      my $ignoring = ignoring();
      pop @ifstack;
      push @ifstack, -$ignoring;
      $verbose && print "ELSE/ELIF: " . ignoring() . "\n";
      return if $ignoring;
    }
  elsif (@ifstack && /^$s\#\s*endif/)
    {
      my $ignoring = pop @ifstack;
      $verbose && print "ENDIF: " . ignoring() . "\n";
      return if ignoring() || $ignoring;
    }
  elsif (/^$s\#\s*include${s}([\"<][^\">]+[\">])/)
    {
      my $codeblock;
      $codeblock->{name} = $1;
      $codeblock->{inline} = 0;

      $includes{$codeblock->{name}} = $codeblock;
      
      label_chunk ($codeblock, "include");
      
      $verbose && print "INCLUDE: " . $codeblock->{name} . "\n";
      return;
    }
  
  # XXX: For now, treat preprocessor stuff besides #include, #if 0 as code.
  handle_source_code ();
}

sub handle_source_code
{
  return if /^[\s\n]*$/;

  my $codeblock = {};
  label_chunk ($codeblock, "code");

  $verbose && print "UNKNOWN: " . $codeblock->{string};
}

sub handle_classdef 
{
  my $class = $_[0];
  label_chunk ($class, "classdef");

  $class->{funcs} = [];

  if ($class->{syntax} ne 'forwarddecl')
    {
      $classes{$class->{name}} = $class;
    }

  $verbose && print "CLASSDEF: " . $class->{name} . " [" 
    . $class->{syntax} . "]\n";
}

sub handle_function 
{
  my $func = $_[0];

  if ($func->{class} ne '')
    {
      $func->{visibility} = "private";
      if (s/^($s)PRIVATE([\s\n])/$1$2/s)
	{
	  $func->{visibility} = "private";
	  $func->{pretext} =~ s|PRIVATE[ \t]*||s;
	}
      elsif (s/^($s)PUBLIC([\s\n])/$1$2/s)
	{
	  $func->{visibility} = "public";
	  $func->{pretext} =~ s|PUBLIC[ \t]*||s;
	}
      elsif (s/^($s)PROTECTED([\s\n])/$1$2/s)
	{
	  $func->{visibility} = "protected";
	  $func->{pretext} =~ s|PROTECTED[ \t]*||s;
	}
      elsif (s/^($s)IMPLEMENT([\s\n])/$1$2/s)
        {
	  # Use a visibility attribute that is never used in adding
	  # declarations to classes in print_classdecl.
	  $func->{visibility} = "implementation_only";
          $func->{pretext} =~ s|IMPLEMENT[ \t]*||s;
        }
    }
  else 
    {
      $func->{visibility} = "public";
    }

  # Interprete more type attributes.
  $func->{inline} = 0;
  $func->{static} = 0;
  $func->{virtual} = 0;
  $func->{explicit} = 0;
  $func->{template} = '';
  $func->{fully_specialized_template} = '';
  while (1)
    {
      if (s/^($s)inline([\s\n])/$1$2/si) # "inline" is case-insensitive.
        {
	  $func->{inline} = 1;
	  $func->{pretext} =~ s|inline[ \t]*||si;
	  @{$func->{needs}} = ();
	  $func->{hide} = 0;
	  while (1)
	    {
	      if (s/^($s)NEEDS\s*\[([^\]]+)\]([\s\n])/$1$3/s)
		{
		  @{$func->{needs}} = split (/\s*,\s*/, $2);
		  $func->{pretext} =~ s|NEEDS\s*\[[^\]]+\][ \t]*||s;
		  next;
		}
	      if (s/^($s)NOEXPORT([\s\n])/$1$2/si)
		{
		  $func->{hide} = 1;
		  $func->{pretext} =~ s|NOEXPORT[ \t]*||s;
		  next;
		}
	      last;
	    }

	  # Reset needed list if this function is hidden.
	  @{$func->{needs}} = () if ($func->{hide});

          next;
        }
     
      if (s/^($s)($template)([\s\n])/$1$3/s)
        {
          $func->{template} = $2;
          $func->{pretext} =~ s/\Q$2//s;
#         $func->{pretext} =~ s|$template[ \t]*||s;
	  $func->{fully_specialized_template} = 'ja' 
	      if $func->{template} =~ /^(?:${s}template$s<${s}>)+${s}$/s;
	  next;
        }

      if (s/^($s)static([\s\n])/$1$2/s)
        {
          $func->{static} = 1;
          $func->{pretext} =~ s|static[ \t]*||s;

	  if ($func->{class} eq '')
	    {
	      $func->{visibility} = "private";
	    }

	  next;
        }

      if (s/^($s)explicit([\s\n])/$1$2/s)
        {
          $func->{explicit} = 1;
          $func->{pretext} =~ s|explicit[ \t]*||s;
	  next;
        }

      if (s/^($s)virtual([\s\n])/$1$2/s)
        {
          $func->{virtual} = 1;
          $func->{pretext} =~ s|virtual[ \t]*||s;
	  next;
        }

      if (/^($s)(PRIVATE|PUBLIC|PROTECTED|IMPLEMENT)([\s\n])/)
        {
	  die "${blockfile}:$blockstart: only one visibility attribute allowed at start of declaration;";
        }

      last;
  }

  label_chunk ($func, "function");

  if ($func->{class} ne '' 
      && ! defined $classes{$func->{class}})
    {
      die "${ARGV}:${lineno}: Class " . $func->{class} 
          . " has not been declared;";
    }

  if ($current_section eq 'INTERFACE')
    {
      die "${ARGV}:${lineno}: Function " . $func->{name} 
          . " in INTERFACE section;";
    }

  push @{$classes{$func->{class}}->{funcs}}, $func;

  $verbose && print "FUNC: " . ($func->{class} ne '' 
				? ($func->{class} . "::")
			        : "")
    . $func->{name} . "\n";
}

#############################################################################

#
# Printing code.
#

sub print_head			# Save header.  Print it only if a
                                # print_expand() follows
{
  $saved_head .= $_[0];
  $saved_indent = $print_indent;
}

sub clear_head
{
  $saved_head = '';
}

sub print_expand($)		# Expands comments and prints to OUT.
{
  my $str = $_[0];

  if ($saved_head ne '')
    {
      local $print_indent = $saved_indent;
      my $str = $saved_head;
      $saved_head = '';

      print_expand $str;	# Recurse.
    }

  $str =~ s/\n(?:[ \t]*\n)+/\n\n/sg if ! $doing_linenumbers;

  while ( $str =~ s/([\001\002])([0-9]+)\1/$comments[$2]/sg )
    {}

  if ($print_indent)
    {
      my $istr = " " x $print_indent;
      $str =~ s/^/$istr/mg;
    }

  print OUT $str;
}

sub print_lineno($)
{
  return if ! $doing_linenumbers;

  my $object = $_[0];

  print_expand '';		# print headers we accumulated
  print OUT "#line " . $object->{line} . " \"" . $object->{file} . "\"\n";
}

sub print_lineno_sans_empty_lines($)
{
  return if ! $doing_linenumbers;

  my $object = $_[0];

  my $start_of_code = $object->{string};
  $start_of_code =~ s/^([\s\n]+).*$/$1/s;

  my @startcomments = split /\n/, " $start_of_code ";

  print OUT "#line " . ($object->{line} + @startcomments - 1)
    . " \"" . $object->{file} . "\"\n";
}

sub weedout_whitespace		# Delete whitespace except on lines w/comments
{
  my $str = $_[0];

  $str =~ s/^[\s\n]+//s;

  if (! $doing_linenumbers)	# more cosmetic changes if we do not
    {				# have to be correct line-number-wise
      my @lines = split /\n/, $str;
      my $foundcode = 0;
      $str = '';
      
      foreach my $line (@lines)
	{
	  $line =~ s/^\s+//;
	  $line =~ s/\s+$//;
	  
	  if ($line =~ /\001/ || $line =~ /^\s*$/)
	    {
	      $line .= "\n";
	    }
	  else
	    {
	      if (! $foundcode)
		{
		  $foundcode = 1;

		  # Found something like code: Remove trailing whitespace
		  # from $str,
		  $str =~ s/\s+$//s;
		  $str .= "\n" if $str ne '';
		}

	      $line =~ s/\s+/ /g;
	      $line .= ' ';
	    }
	  $str .= $line;
	}
    }

  $str =~ s/\s+$//;

  return $str;
}

sub func_prototype($)		# Return a function declaration from
                                # func head.
{
  my $func = $_[0];
  my $pretext = $func->{pretext};

  if ($func->{explicit}) 
    {
      $pretext =~ s/^($s)/${1}explicit /s;
    }

  if ($func->{static}) 
    {
      $pretext =~ s/^($s)/${1}static /s;
    }

  if ($func->{virtual}) 
    {
      $pretext =~ s/^($s)/${1}virtual /s;
    }

  if ($func->{template} ne '' && $func->{class} eq '') 
    {
      $pretext =~ s/^($s)/${1}$func->{template} /s;
    }

  my $func_header = weedout_whitespace($pretext . 
				       $func->{name} . $func->{args});

  # Insert ; at the correct place, that is, before any comments.
  $func_header =~ s/($s)$/;$1/s;

  return $func_header;
}

sub print_funcdecl($)
{
  my $function = $_[0];

  if ($function->{visibility} ne "implementation_only")
    {
      print_expand "\n";
      print_lineno_sans_empty_lines $function;
      print_expand func_prototype($function) . "\n";
    }

  # Handle inlines.
  if ($doing_inlines && $function->{inline})
    {
      handle_inline ($function);
    }
}

sub print_classdecl($)
{
  my $class = $_[0];

  print_lineno $class;

  if ($class->{syntax} =~ /^(?:struct|class)$/)
    {
      if (! $doing_inlines)
	{
	  $class->{pretext} =~ s/\binline\b[ \t]*//g;
	}

      print_expand $class->{pretext};

      print_head "\npublic:";
      $print_indent += 2;
      foreach my $function (grep {$_->{visibility} eq "public"}
			         @{$class->{funcs}})
	{
	  print_funcdecl $function;
	}
      $print_indent -= 2;
      clear_head();
      print_head "\nprotected:";
      $print_indent += 2;
      foreach my $function (grep {$_->{visibility} eq "protected"} 
			         @{$class->{funcs}})
	{
	  print_funcdecl $function;
	}
      $print_indent -= 2;
      clear_head();
      print_head "\nprivate:";
      $print_indent += 2;
      foreach my $function (grep {$_->{visibility} eq "private"} 
			         @{$class->{funcs}})
	{
	  print_funcdecl $function;
	}
      $print_indent -= 2;
      clear_head();

      # Also, don't forget to "print" already-declared functions.
      # (This will not actually print anything, but do other processing.)
      foreach my $function (grep {$_->{visibility} eq "implementation_only"}
			         @{$class->{funcs}})
	{
	  print_funcdecl $function;
	}

      print_expand $class->{posttext};
    }
  else
    {
      print_expand $class->{string};
    }
}

sub print_funcdef($)
{
  my $function = $_[0];
  my $pretext = $function->{pretext};

  if ($doing_inlines && $function->{inline})
    {
      $pretext =~ s/^($s)/${1}inline /s;
    }

  if ($function->{static} && $function->{class} eq '')
    {
      $pretext =~ s/^($s)/${1}static /s;
    }

  if ($function->{template} ne  '')
    {
      $pretext =~ s/^($s)/${1}$function->{template} /s;
    }

  # Remove default arguments from argument list
  my $args = $function->{args};
  my $parengroup = qr{		# Matches correctly-nested groups of parens
		      \(
		      (?:
		       (?> [^()]* )        # Non-parens without backtracking
		       |
		       (??{ $parengroup }) # Backtrack: Group with parens
		      )*
		      \)
		     }x;
  my $expr = qr{ [^(),]* (?:$parengroup)? [^(),]* }x;
  $args =~ s/$s = $expr//gx;

  print_expand "\n";
  print_lineno $function;
  print_expand $pretext 
    . ($function->{class} ne '' 
       ? $function->{class} . $function->{templateargs} 
           . "::" . $function->{name}
       : $function->{name} . $function->{templateargs})
    . $args . $function->{posttext};
}

sub print_code($)
{
  my $codeblock = $_[0];
  print_lineno $codeblock;
  print_expand $codeblock->{string};
}

#############################################################################

#
# Inline-function bookkeeping.
#

sub lookup_by_name		# Return (list of) item(s) matching name.
{
  my ($item, $context) = @_;

  # Is it a class name?
  if (defined $classes{$item})
    {
      return $classes{$item};
    }

  # Is it an include file?
  if (defined $includes{$item})
    {
      $includes{$item}->{inline} = 1;
      return $includes{$item};
    }

  # Must be a function name!
  my ($classname, $funcname);
  
  if ($item =~ /::/)
    {
      ($classname, $funcname) = split /::/, $item;
    }
  else 
    {
      ($classname, $funcname) = ('' , $item);
    }

  my @grepresult = grep {$_->{name} eq $funcname && $_->{inline}} 
	                 @{$classes{$classname}->{funcs}};

  return shift @grepresult
    if (scalar @grepresult == 1);

  die "${ARGV}:" . $context->{line} . ": Cannot find inline code for $item;"
    if (scalar @grepresult == 0);

  return @grepresult;	# Return list of matching function names.
}

# sub object_name
# {
#   my $object = $_[0];

#   return ((defined $object->{class} 
# 	   && $object->{class} ne '') 
# 	  ? $object->{class} . "::" . $object->{name}
# 	  : $object->{name});
# }

sub handle_inline
{
  my $function = $_[0];

  my $class = $function->{class};
  my @needed = ();

  foreach my $item (@{$function->{needs}})
    {
      push @needed, lookup_by_name ($item, $function);
    }
  
  push @needed, $function;
  unshift @needed, lookup_by_name ($function->{class}, $function)
    if ($function->{class} ne '');

 NEEDEDLOOP:
  while (@needed)
    {
      my $object = $needed[0];

      if (exists $public_inline{$object}
	  || ($function->{visibility} eq 'private'
	      && exists $private_inline{$object}))
	{
	  shift @needed;
	  next;
	}
      
      my @moreneeded = ();
      
      # Check for further dependencies.
      if (defined $object->{needs})
	{
	  foreach my $item (@{$object->{needs}})
	    {
	      push @moreneeded, lookup_by_name ($item, $object);
	    }
	}  

      # Check if we have everything that's needed for $item.
      foreach my $i (@moreneeded)
	{
	  if (exists $public_inline{$i}
	      || ($function->{visibility} eq 'private'
		  && exists $private_inline{$i}))
	    {
	      next;
	    }
	  
	  unshift @needed, $i;
	  next NEEDEDLOOP;
	}
      
      push @inline_order, $object
	if ! (exists $private_inline{$object}
	      || exists $public_inline{$object});

      if ($function->{visibility} eq 'private'
	  || $function->{hide})
	{
	  $private_inline{$object} = 1;
	}
      else
	{
	  $public_inline{$object} = 1;
	}
      shift @needed;
    }
}

sub print_inlines
{
  foreach my $object (@_)
    {
      next if ($object->{type} eq "include");

      if ($object->{type} eq "classdef")
	{
	  if ($object->{section} ne 'INTERFACE')
	    {
	      print_classdecl $object;
	    }
	  next;
	}

      print_funcdef $object;
    }
}