use Parse::RecDescent;
my $grammar;
END { 
	my $g = $grammar;
	$g =~ s/db\([^()]+\);//g;
	Parse::RecDescent->Precompile($g, "HTML::Transmorgify::Conditionals");
	rename("Conditionals.pm", "lib/HTML/Transmorgify/Conditionals.pm") or die "rename: $!";
	$grammar =~ s/sub db/\$::RD_TRACE = 1; sub db/;
	Parse::RecDescent->Precompile($grammar, "HTML::Transmorgify::ConditionalsDebug");
	rename("ConditionalsDebug.pm", "lib/HTML/Transmorgify/ConditionalsDebug.pm") or die "rename: $!";
}

$grammar = <<'END_OF_FILE';

#
# perl -MParse::RecDescent - grammar HTML::Transmorgify::Conditionals
#

{
	use Carp qw(confess);

	our @rtmp;

	sub db
	{
		require Data::Dumper;
		print Data::Dumper::Dumper((caller(1))[3], @_);
	}

	my $allowed_funcs = \%HTML::Transmorgify::allowed_functions;
	sub run
	{
		return $_[0] unless ref $_[0];
		return $_[0]->();
	}

	sub binary
	{
		db(@_);
		my ($t1, $op, $t2) = @_;
		confess if ref $op;
		my $eval = "sub { \$_[0] $op \$_[1] }";
		$allowed_funcs->{$op} ||= eval $eval or die "eval $eval: $@";
		return sub {
			$allowed_funcs->{$op}->(run($t1), run($t2));
		};
	}

	sub unary
	{
		db(@_);
		my ($op, $t1) = @_;
		confess if ref $op;
		my $eval = "sub { $op \$_[0] }";
		$allowed_funcs->{$op} ||= eval $eval or die "eval $eval: $@";
		return sub {
			$allowed_funcs->{$op}->(run($t1));
		};
	}
		
	sub assoc
	{
		db(@_);
		my ($r, @ops) = @_;
		while (my ($op, $term) = splice(@ops, 0, 2)) {
			confess if ref $op;
			my $eval = "sub { \$_[0] $op \$_[1] }";
			$allowed_funcs->{$op} ||= eval $eval or die "eval $eval: $@";
			my $left = $r;
			$r = sub {
				$allowed_funcs->{$op}->(run($left), run($term));
			};
		}
		return $r;
	}

	sub left
	{
		db(@_);
		assoc(@{$_[1]});
	}

	sub right
	{
		db(@_);
		assoc(reverse @{$_[1]});
	}

	sub nonassoc
	{
		db(@_);
		die if @{$_[1]} > 3;
		left(@_);
	}
}

conditional: expr /\Z/
	{ db(@item); $item[1] }

expr: <leftop: expr2 expr_op  expr2>
	{ db(@item); left(@item) }

expr_op: /or|xor/
	{ db(@item); $item[1] }

expr2: <leftop: expr5 expr2op  expr5>
	{ db(@item); left(@item) }

expr2op: "and"
	{ db(@item); return $item[1] }

expr5: "not" expr6 
	{ db(@item); unary('not', $item[2]) }
  | expr6
	{ db(@item); $item[1] }

expr6: expr7 "?" expr7 ":" expr6
	{ db(@item); sub { run($item[1]) ? run($item[3]) : run($item[5]) } }
  | expr7
	{ db(@item); $item[1] }

expr7: <leftop: expr8 expr7op expr8>
	{ db(@item); left(@item) }

expr7op: "||"
	{ db(@item); $item[1] }

expr8: <leftop: expr9 expr8op  expr9>
	{ db(@item); left(@item) }

expr8op: "&&"
	{ db(@item); $item[1] }

expr9: <leftop: expr10 expr9op expr10>
	{ db(@item); left(@item) }

expr9op: /(\||\^)/ 
	{ db(@item); $item[1] }

expr10: <leftop: expr11 expr10op expr11>
	{ db(@item); left(@item) }

expr10op: /(\&)/ 
	{ db(@item); $item[1] }

expr11: <leftop: expr12 expr11op expr12>
	{ db(@item); nonassoc(@item) }

expr11op: /(==|\!=|<=>|eq|ne|cmp)/ 
	{ db(@item); $item[1] }

expr12: <leftop: expr13 expr12op expr13>
	{ db(@item); nonassoc(@item) }

expr12op: /(<|>|<=|>=|lt|gt|le|ge)/ 
	{ db(@item); $item[1] }

expr13: <leftop: expr14 expr13op expr14>
	{ db(@item); left(@item) }

expr13op: /(<<|>>)/ 
	{ db(@item); $item[1] }

expr14: <leftop: expr15 expr14op expr15>
	{ db(@item); left(@item) }

expr14op: /(\+|-|\.)/ 
	{ db(@item); $item[1] }

expr15: <leftop: expr15a expr15op expr15a>
	{ db(@item); left(@item) }

expr15op: /(\*|\/|%|x)/ 
	{ db(@item); $item[1] }

expr15a: '-' expr16 
	{ db(@item); binary(0, '-', $item[1]) }
  | expr16
	{ db(@item); $item[1] }

expr16: <leftop: expr17 expr16op expr17>
	{ db(@item); left(@item) }

expr16op: /(=~|\!~)/ 
	{ db(@item); $item[1] }

expr17: <leftop: term expr17op term>
	{ db(@item); left(@item) }

expr17op: /(\*\*)/ 
	{ db(@item); $item[1] }

term: '(' expr ')'
	{ db(@item); $return = $item[2] }
  | constant
	{ db(@item); $return = $item[1] }
  | macro
	{ db(@item); $return = $item[1] }
  | function
	{ db(@item); $return = $item[1] }

function: /[A-Za-z_](?:\w|::(?=[^:]))*/ '(' expr(s /,/) ')'
	{ 
		db(@item);
		die unless $allowed_funcs->{$item[1]};
		$return = sub {
			$allowed_funcs->{$item[1]}->( map { run($_) } @item[3..$#item] );
		};
	}

constant: / -? (?: \d+ (?: \.\d+ )? | (?: \.\d+) ) (?:[eE]-?\d+)? /x
	{ db(@item); $item[1] }
  | "'" /[^"]*/ '"'
	{ db(@item); $item[2] }
  | '"' /[^']*/ "'"
	{ db(@item); $item[2] }

macro: /<macro (?: [^'">] | '[^'<>]*' | "[^"<>]*" )* >/x
	{
		db(@item);
		my $buf = HTML::Transmorgify::compile($HTML::Transmorgify::modules, \$item[1]);
		$return = sub {
			local(@rtmp) = ( '' );
			run($buf, \@rtmp);
			return $rtmp[0];
		};
	}


END_OF_FILE