view release on metacpan or  search on metacpan

lib/AI/Prolog/Parser/PreProcessor/Math.pm  view on Meta::CPAN

        $prolog =~ s/\Q$old_expression\E/$new_expression/g;
    }
    return $prolog;
}

sub _lex {
    my ( $class, $rhs ) = @_;
    my $lexer = _lexer($rhs);
    my @tokens;
    while ( my $token = $lexer->() ) {
        push @tokens => $token;
    }
    return \@tokens;
}

sub _lexer {
    my $rhs = shift;

   # the entire "$prev_op" thing is to allow the lexer to be aware of '7 + -3'
   # $op_ok is false on the first pass because it can never be first, but we
   # might have '-7 * (-2 + 3)'
    my $op_ok = 0;
    return sub {
    LEXER: {
            $op_ok = 0, return [ 'OP', $1 ]
                if $op_ok && $rhs =~ /\G ($op)               /gcx;
            $op_ok = 1, return [ 'ATOM', $1 ]
                if $rhs =~ /\G ($simple_math_term) /gcx;
            $op_ok = 0, return [ 'LPAREN', '(' ]
                if $rhs =~ /\G $lparen             /gcx;
            $op_ok = 1, return [ 'RPAREN', ')' ]
                if $rhs =~ /\G $rparen             /gcx;
            redo LEXER if $rhs =~ /\G \s+                 /gcx;
        }
    };
}

sub _parse {
    my ( $class, $tokens ) = @_;
    my $parens_left = 1;
REDUCE: while ($parens_left) {
        my ( $first, $last );
        for my $i ( 0 .. $#$tokens ) {
            my $token = $tokens->[$i];
            next unless $token;
            if ( "(" eq _as_string($token) ) {
                $first = $i;
            }
            if ( ")" eq _as_string($token) ) {
                unless ( defined $first ) {

                # XXX I should probably cache the string and show it.
                # XXX But it doesn't matter because that shouldn't happen here
                    croak(
                        "Parse error in math pre-processor.  Mismatched parens"
                    );
                }
                $last = $i;
                $tokens->[$first] = $class->_parse_group(
                    [ @{$tokens}[ $first + 1 .. $last - 1 ] ] );
                undef $tokens->[$_] for $first + 1 .. $last;
                @$tokens = grep $_ => @$tokens;
                undef $first;
                undef $last;
                redo REDUCE;
            }
        }
        $parens_left = 0 unless defined $first;
    }
    return _as_string( $class->_parse_group($tokens) );
}

sub _parse_group {
    my ( $class, $tokens ) = @_;
    foreach my $op_re ( qr{(?:\*\*|[*/])}, qr{[+-]}, qr/\%/ ) {
        for my $i ( 0 .. $#$tokens ) {
            my $token = $tokens->[$i];
            if ( ref $token && "@$token" =~ /OP ($op_re)/ ) {
                my $curr_op = $1;
                my $prev    = _prev_token( $tokens, $i );
                my $next    = _next_token( $tokens, $i );
                $tokens->[$i] = sprintf
                    "%s(%s, %s)" => $convert{$curr_op},
                    _as_string( $tokens->[$prev] ),
                    _as_string( $tokens->[$next] );
                undef $tokens->[$prev];
                undef $tokens->[$next];
            }
        }
        @$tokens = grep $_ => @$tokens;
    }

    #main::diag Dumper $tokens;
    return $tokens->[0];    # should never have more than on token left
}

sub _prev_token {
    my ( $tokens, $index ) = @_;
    for my $i ( reverse 0 .. $index - 1 ) {
        return $i if defined $tokens->[$i];
    }
}

sub _next_token {
    my ( $tokens, $index ) = @_;
    for my $i ( $index + 1 .. $#$tokens ) {
        return $i if defined $tokens->[$i];
    }
}

sub _as_string { ref $_[0] ? $_[0][1] : $_[0] }

sub match { shift; shift =~ $expression }

# The following are testing hooks

sub _compare            { shift; shift =~ /^$compare$/ }
sub _op                 { shift; shift =~ /^$op$/ }
sub _simple_rhs         { shift; shift =~ /^$simple_rhs$/ }
sub _simple_group_term  { shift; shift =~ /^$simple_group_term$/ }
sub _simple_math_term   { shift; shift =~ /^$simple_math_term$/ }
sub _math_term          { shift; shift =~ /^$math_term$/ }
sub _complex_rhs        { shift; shift =~ /^$complex_rhs$/ }
sub _complex_group_term { shift; shift =~ /^$complex_group_term$/ }

1;

__END__

=head1 NAME

AI::Prolog::Parser::PreProcessor::Math - The AI::Prolog math macro

=head1 SYNOPSIS

 my $program = AI::Prolog::Parser::PreProcessor::Math->process($prolog_text).

=head1 DESCRIPTION

This code reads in the Prolog text and rewrites it to a for that is suitable
for the L<AI::Prolog::Parser|AI::Prolog::Parser> to read.  Users of
L<AI::Prolog||AI::Prolog> should never need to know about this.

=head1 TODO

Constant folding for performance improvment.  No need to internally have
C<is(X, plus(3, 4))> when I can do C<is(X, 5)>.  It shouldn't be too hard.