The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
# Lhs.eyp

%right  '='
%left   '-' '+'
%left   '*' '/'
%left   NEG

%defaultaction { 
  my $self = shift;
  my $name = $self->YYName();
  bless { children => [ grep {ref($_)} @_] }, $name; 
}

%%
input:    
            /* empty */
              { [] }
        |   input line  
              { 
                push @{$_[1]}, $_[2] if defined($_[2]);
                $_[1]
              } 
;

line:     '\n'       { } 
        | exp '\n'   {  $_[1] } 
;

exp:        
            NUM   { $_[1] } 
        |   VAR   { $_[1] } 
        |   %name ASSIGN
            VAR '=' exp         
        |   %name PLUS
            exp '+' exp         
        |   %name MINUS
            exp '-' exp        
              {
                my $self = shift;
                $self->YYName('SUBTRACT'); # rename it
                $self->YYBuildAST(@_); # build the node
              }
        |   %name TIMES
            exp '*' exp       
        |   %name DIV
            exp '/' exp      
        |   %name UMINUS
            '-' exp %prec NEG 
        |  '(' exp ')'  { $_[2] }
;

%%

sub _Error {
        exists $_[0]->YYData->{ERRMSG}
    and do {
        print $_[0]->YYData->{ERRMSG};
        delete $_[0]->YYData->{ERRMSG};
        return;
    };
    print "Syntax error.\n";
}

sub _Lexer {
    my($parser)=shift;

    for ($parser->YYData->{INPUT}) {
        s/^[ \t]+//;
        return('',undef) unless $_;
        s/^([0-9]+(?:\.[0-9]+)?)//
                and return('NUM', bless { attr => $1}, 'NUM');
        s/^([A-Za-z][A-Za-z0-9_]*)//
                and return('VAR',bless {attr => $1}, 'VAR');
        s/^(.)//s
                and return($1, $1);
    }
    return('',undef);
}

sub Run {
    my($self)=shift;

    $self->YYData->{INPUT} = <>;
    return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error  );
}