The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Tail;
use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;
use Scalar::Util qw{blessed};

sub _Error {
  my $parser = shift;
  my $yydata = $parser->YYData;

    exists $yydata->{ERRMSG}
  and do {
      warn $yydata->{ERRMSG};
      delete $yydata->{ERRMSG};
      return;
  };
  my($token)=$parser->YYCurval;
  my($what)= $token->[0] ? "input: '$token->[0]'" : "end of input";
  my @expected = $parser->YYExpect();
  my $next = substr($parser->{input}, pos($parser->{input}), 5);
  local $" = ', ';
  warn << "ERRMSG";

Syntax error near $what (lin num $token->[1]). 
Incoming text: 
===
$next
===
Expected one of these terminals: @expected
ERRMSG
}


{ # closure

my $lineno = 1;
my %lexemename;

  sub set_lexemename {
    my $self = shift;
    my %names = @_;

    my @keys = keys(%names);

    @lexemename{@keys} = values(%names);

    return @lexemename{@keys};
  }

  sub lexer {
    my $parser = shift;

    my $beginline = $lineno;
    for ($parser->{input}) {    # contextualize
      m{\G[ \t\n]*(\#.*)?}gc;

      m{\G([0-9]+(?:\.[0-9]+)?)}gc   and return ('NUM', [$1, $beginline]);
      m{\G([A-Za-z][A-Za-z0-9_]*)}gc and return ('VAR', [$1, $beginline]);
      m{\G(.)}gc                     and do {
        my $token = exists $lexemename{$1}? $lexemename{$1} : $1;
        return ($token, [$token, $beginline]);
      };

      return('',undef);
    }
  }
} # closure

sub Run {
    my($self)=shift;
    my $yydebug = shift || 0;

    return $self->YYParse( 
      yylex => \&lexer, 
      yyerror => \&_Error,
      yydebug => $yydebug, # 0x1F
    );
}

sub uploadfile {
  my $file = shift;
  my $msg = shift;

  my $input = '';
  eval {
    $input = Parse::Eyapp::Base::slurp_file($file) 
  };
  if ($@) {
    print $msg;
    local $/ = undef;
    $input = <STDIN>;
  }
  return $input;
}

sub main {
  my $package = shift;
  my $prompt = shift || "Expressions. Press CTRL-D (Unix) or CTRL-Z (Windows) to finish:\n";

  my $debug = 0;
  my $file = '';
  my $showtree = 0;
  my $help;
  my $result = GetOptions (
    "debug!" => \$debug,  
    "file=s" => \$file,
    "tree!"  => \$showtree,
    "help"   => \$help,
  );

  pod2usage() if $help;

  $debug = 0x1F if $debug;
  $file = shift if !$file && @ARGV; 

  my $parser = $package->new();
  $parser->{input} = uploadfile($file, $prompt);
  my $tree = $parser->Run( $debug );

  print $tree->str()."\n" if $showtree && blessed($tree) && $tree->isa('Parse::Eyapp::Node');
}

sub semantic_error {
  my ($parser, $msg) = @_;

  $parser->YYData->{ERRMSG} = $msg;
  $parser->YYError; 
}

1;