use strict; use warnings; use 5.010;

package Parser;

use Data::Dumper;
use Marpa::R2;

my $grammar;

BEGIN {
    $grammar = Marpa::R2::Scanless::G->new({
        bless_package => 'Ast',
        source => \<<'END SOURCE',
            :default    ::= action => [start,values] bless => ::lhs
            inaccessible is ok by default
            :start      ::= list
            :discard    ~ ws

list ::= content +
content ::= word operator number
word ::= W
number ::= N
operator ::= OP

W ~ [a-zA-Z_]+
N ~ [0-9]+
OP ~ [=/*+-]
ws      ~ [\s]+

fakecpp ::= cpp
cpp ~ '#'

END SOURCE
    });
}

my $data = <<EOFDATA;
abc 
#ifdef A 
= 
#else
+
#endif
12
EOFDATA

my $ast = parse(\$data);
print Dumper $ast;


#---------------------------------------------------------------------

sub parse {
    my ($ref) = @_;
    my $recce = Marpa::R2::Scanless::R->new({ 
	grammar => $grammar,
	rejection => 'event',
	semantics_package => 'C',
#        trace_terminals => 1,
#        trace_values => 1,
					    });
    my $val = process($recce, $ref) // die "No parse found";
    return $$val;
}

sub process {
	my($recce, $ref) = @_;
	my $string = $$ref;
	my($length) = length $string;

	my(@event, $event_name);
	my($lexeme, $lexeme_name, $literal);
	my($start, $span);
	my($value);

	for
	(
		my $pos = $recce -> read(\$string);
		$pos < $length;
		$pos = $recce -> resume($pos)
	)
	{
		@event          = @{$recce -> events};
		$event_name     = ${$event[0]}[0];
		($start, $span) = $recce -> pause_span;
		$lexeme_name    = $recce -> pause_lexeme;
		$lexeme         = $recce -> literal($start, $span) if defined $start;

		if ($event_name eq q('rejected)) {
		    if (substr($string,$pos,1) eq '#') {
			my $found = substr($string, $pos) =~ 
			    /^#ifdef(\s*)(\w+)*(\s*\n)(.*?)\n#else(.*?)\n#endif/so;
			die "Incomplete lexeme found at:".substr($string,$pos,10)."\n" unless $found;
			my $cpp1 = $2;
			my $cpp2 = $4;
			my $cpp3 = $5;
			my $newlen = length($cpp2);
			my $len = 
			    length($1) + length($cpp1) + length($3) +
			    $newlen + length($cpp3) + 19;
			# interesting data:
			# @{$recce->terminals_expected}
			# $recce->progress
			# $recce->current_g1_location
			my ($line, $col) = $recce->line_column();

			$pos = $pos + $len - $newlen + 1;
			substr($string, $pos, $newlen) = $cpp2;
		    } else {
			# We now have another rejection
			die "Rejected lexeme at:".substr($string,$pos,10)."\n";
		    }
		} else {
			die "Unexpected lexeme '$lexeme_name' with a pause\n";
		}
	}

	return $recce -> value;

}


__END__

