File Coverage

blib/lib/PERLANCAR/Parse/Arithmetic/NoHash.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	3	6	50.0
condition			n/a
subroutine	5	5	100.0
pod	1	1	100.0
total	36	39	92.3

package PERLANCAR::Parse::Arithmetic::NoHash;

our $DATE = '2016-06-18'; # DATE
our $VERSION = '0.003'; # VERSION

use 5.010001;
use strict;
use warnings;

my ($match_top,
    $match_add, $match_op_add,
    $match_mult, $match_op_mult,
    $match_pow,
);

use Exporter qw(import);
our @EXPORT_OK = qw(parse_arithmetic);

sub parse_arithmetic {
    state $RE =
        qr{
              (?&TOP)
              (?{
                  $match_top = $^R;
              })

              (?(DEFINE)

                  (?
                      ^\s* (?&EXPR) \s*$
                  )

                  (?
                      (?&MULT_EXPR)
                      (?{
                          $match_add = $^R
                      })
                      (?: \s* ([+-])
                          (?{
                              $match_op_add = $^N;
                          })
                          \s* (?&MULT_EXPR)
                          (?{
                              $match_add = $match_op_add eq '+' ? $match_add + $^R : $match_add - $^R;
                          })
                          )*
                  )

                  (?
                      (?&POW_EXPR)
                      (?{
                          $match_mult = $^R;
                      })
                      (?: \s* ([*/])
                          (?{
                              $match_op_mult = $^N;
                          }) \s*
                          (?&POW_EXPR)
                          (?{
                              $match_mult = $match_op_mult eq '*' ? $match_mult * $^R : $match_mult / $^R;
                          })
                          )*
                  )

                  (?
                      (?&TERM)
                      (?{
                          $match_pow = [$^R];
                      })
                      (?: \s* \*\* \s* (?&TERM)
                          (?{
                              unshift @$match_pow, $^R;
                          })
                      )*
                      (?{
                          # because ** is right-to-left, we collect first then
                          # apply from right to left
                          my $res = $match_pow->[0];
                          for (1..$#{$match_pow}) {
                              $res = $match_pow->[$_] ** $res;
                          }
                          $res;
                      })
                  )

                  (?
                      \( \s* (?&EXPR)
                      (?{
                          $^R;
                      })
                      \s* \)
                  |   (?&LITERAL)
                      (?{
                          $^R;
                      })
                  )

                  (?
                      (-?(?:\d+|\d*\.\d+))
                      (?{
                          $^N;
                      })
                  )
              )
      }x;
    $_[0] =~ $RE or return undef;
    $match_top;
}

1;
# ABSTRACT: Parse arithmetic expmatchsion

__END__