#!/usr/bin/perl -w
# simple macro processor -- parameterless macros.
# ${} encloses a macro invocation;
# ${x=y} defines x to be y.
# ${$} is '$'
# ${} is '}'
# macro output is not reparsed.
# macro definitions and names have macros in them expanded.
# Computation should not be done by reparsing output :)
#
# whitespace in macro names is reduced to a single space.  Whitespace at
# the ends is elided.  Not so values.  They can have whitespace wherever
# they want.
use strict;

sub expand_macro;
sub define_macro;
sub trim_whitespace;
sub parse_text;

sub expand_macro {
	my ($table, $name) = @_;
	$name = trim_whitespace $name;
	return $table->{$name} if exists $table->{$name};
	# Otherwise,
	die 'Undefined macro ${' . $name . '}';
}

sub define_macro {
	my ($table, $name, $value) = @_;
	my $realname = trim_whitespace $name;
	$table->{$realname} = $value;
}

sub trim_whitespace {
	my ($line) = @_;
	$line =~ s/\s+/ /g;
	$line =~ s/^ //;
	$line =~ s/ $//;
	return $line;
}

# syntax correctness is simple.
# If every ${ is matched by a } that follows it, we're OK.  Otherwise we're
# not.
# Returns 'Bad nesting' if nest count drops below zero;
# Returns 'Incomplete' if nest count ends above zero;
# Returns 'OK' and a parse tree if the string parses OK.
# See next comment for parse tree structure.
sub parse_text {
	my ($string) = @_;
	local $_ = $string;
	my @treestack = ( [] );
	my $curpos = 0;
	for (;;) {
		m/\$\{|\}|$/sg or last;
  		if ($curpos != length $`) {
			my $string = 
				substr ($_, $curpos, length ($`) - $curpos);
  			push @{$treestack[-1]}, \$string;
  		} 
		$curpos = pos $_;
		# print STDERR scalar @treestack, ": <$&:$'>\n";
		if ($& eq '${') {
			push @treestack, [];
			push @{$treestack[-2]}, $treestack[-1];
		}
		if ($& eq '}' ) {
			pop @treestack;
		}
		if (@treestack < 1) { return "Bad nesting"; }
	}
	if (@treestack == 1) {
		return "OK", $treestack[0];
	} else {
		return "Incomplete";
	}
}

# Parse tree structure:
# a tree of lists;
# Some elements of lists are scalars -- just strings -- and some elements 
# are references to other lists.
# There are two main operations you can do on a subtree of the parse tree:
# you can find its inside value, and you can pass it through the macro
# expander to find its outside value.
# The main body of the program is finding the inside value of each line and
# printing it out.

my %macros = (
	'$' => '$',
	''  => '}',
);

sub expand_general_macro;
sub inside_value;
sub outside_value;

sub expand_general_macro {
	my ($macro_name) = @_;
	if ($macro_name =~ /\=/) {
		define_macro \%macros, $`, $';
		return "";
	} else {
		return expand_macro \%macros, $macro_name;
	}
}

sub inside_value {
	my ($subtree) = @_;
	# assume ref $subtree is ARRAY.
	local $_;
	my $retval = '';
	for (@$subtree) {
		if (ref $_ eq "ARRAY") {
			$retval .= outside_value $_;
		} else {
			$retval .= $$_;
		}
	}
	return $retval;
}

sub outside_value {
	my ($subtree) = @_;
	return expand_general_macro inside_value $subtree;
}

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

my $text = '';
my $startlineno = 1;
my ($status, $tree);
line: while (<>) {
	$text .= $_;
	($status, $tree) = parse_text $text;
	next line if $status eq 'Incomplete';
	if ($status eq 'Bad nesting') {
		print STDERR "The following block (lines $startlineno to $.) has ",
		      "bad nesting:\n";
		print STDERR $text;
	} elsif ($status eq 'OK') {
		eval {
			print inside_value $tree;
		};
		if ($@ =~ /^Undefined macro/) {
			print STDERR $@;
			print STDERR "This was in lines $startlineno to $.:\n";
			print STDERR $text;
		} elsif ($@) {
			die $@;
		}
	} else {
		print "Um, status is $status; I don't understand. \n";
	}
	# If we got here, it's not incomplete, whatever it is.
	$startlineno = $.;
	$text = '';
}

