💾 Archived View for thrig.me › blog › 2024 › 05 › 04 › expression.pl captured on 2024-07-09 at 02:24:17.

View Raw

More Information

⬅️ Previous capture (2024-05-10)

-=-=-=-=-=-=-

#!/usr/bin/env perl
# expression.pl - parse a mathematical expression, a modification of
# Parser::MGC::Examples::EvaluateExpression
use 5.36.0;

my %variables = ( N => 6 );

package Apricot::Expression {
    use base qw[Parser::MGC];

    sub parse ($self) {
        my $val = $self->parse_term;
        1 while $self->any_of(
            sub { $self->expect('+'); $val += $self->parse_term; 1 },
            sub { $self->expect('-'); $val -= $self->parse_term; 1 },
            sub { 0 },
        );
        return $val;
    }

    sub parse_term ($self) {
        my $val = $self->parse_factor;
        1 while $self->any_of(
            sub { $self->expect('*'); $val *= $self->parse_factor; 1 },
            sub { $self->expect('/'); $val /= $self->parse_factor; 1 },
            sub { 0 },
        );
        return $val;
    }

    sub parse_factor ($self) {
        $self->any_of(
            sub {
                $self->scope_of( '(', sub { $self->parse }, ')' );
            },
            sub { $self->token_float },
            sub {
                $self->expect('INT(');
                int $self->scope_of( undef, sub { $self->parse }, ')' );
            },
            sub {
                state $last = rand();
                $self->expect('RND(');
                my $x = $self->scope_of( undef, sub { $self->parse }, ')' );
                if ( $x > 0 ) {
                    return $last = rand;
                } elsif ( $x < 0 ) {
                    srand unpack J => pack F => $x;
                    return $last = rand;
                } else {
                    return $last;
                }
            },
            sub {
                my $var = $self->expect(qr/[A-Z][A-Z0-9]?/);
                $variables{$var} // $self->die("no such variable '$var'");
            }
        );
    }
}

say Apricot::Expression->new->from_string("@ARGV");