view release on metacpan or  search on metacpan

lib/App/EvalServerAdvanced/ConstantCalc.pm  view on Meta::CPAN

package App::EvalServerAdvanced::ConstantCalc;

our $VERSION = '0.06';

# ABSTRACT: turns strings and constants into values

use v5.24;
use Moo;
use Function::Parameters;
use Data::Dumper;

has constants => (is => 'ro', default => sub {+{}});
has _parser => (is => 'ro', default => sub {App::EvalServerAdvanced::ConstantCalc::Parser->new(consts => $_[0])});

method get_value($key) {
  die "Missing constant [$key]" unless exists($self->constants->{$key});

  return $self->constants->{$key};
}

method add_constant($key, $value) {
  die "Invalid key [$key]" if ($key =~ /\s/ || $key =~ /^\s*\d/);

  if (exists($self->constants->{$key}) && defined(my $eval = $self->constants->{$key})) {
    die "Cannot redefine a constant [$key].  Existing value [$eval] new value [$value]"
  }

  die "Value undefined for [$key]" unless defined($value);
  die "Value [$value] for [$key] must be an integer" if ($value =~ /[^xob\d\-+_]/i);

  $self->constants->{$key} = App::EvalServerAdvanced::ConstantCalc::Parser::_to_int($value);
}

method calculate($string) {
  return $self->_parser->from_string($string);
}

package
  App::EvalServerAdvanced::ConstantCalc::Parser;

use strict;
use warnings;

# Ensure we can't accidentally turn to strings, or floats, or anything other than an integer
use integer;
no warnings 'experimental::bitwise';
use feature 'bitwise';

use parent qw/Parser::MGC/;
use Function::Parameters;

method new($class: %args) {
  my $consts = delete $args{consts};

  my $self = $class->SUPER::new(%args);

  $self->{_private}{consts} = $consts;

  return $self;
}

method consts() {
  return $self->{_private}{consts};
}

method parse_upper() {
  my $val = $self->parse_term();

  1 while $self->any_of(
    sub {$self->expect("&"); $val &= $self->parse_term(); 1},
    sub {0}
  );

  return $val;
}

method parse() {
  my $val = $self->parse_upper();

  1 while $self->any_of(
      sub {$self->expect("^"); $val ^= $self->parse_upper(); 1 },
      sub {$self->expect("|"); $val |= $self->parse_upper(); 1 },
      sub {0}
  );

  return $val;
}

method parse_term() {
   $self->any_of(
      sub { $self->scope_of( "(", sub { $self->parse }, ")" ) },
      sub { $self->expect('~['); my $bitdepth=$self->token_int; $self->expect(']'); my $val = $self->parse_term; (~ ($val & _get_mask($bitdepth))) & _get_mask($bitdepth)},
      sub { $self->expect('~'); ~$self->parse_term},
      sub { $self->token_constant },
      sub { $self->token_int },
   );
}

method token_int() {
  0+$self->any_of(
     sub {_to_int($self->expect(qr/0x[0-9A-F_]+/i));},
     sub {_to_int($self->expect(qr/0b[0-7_]+/i));},
     sub {_to_int($self->expect(qr/0o?[0-7_]+/i));},
     sub {$self->expect(qr/\d+/)}