1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

package DiceParser {
    use Moo;

    sub parse($self, $input) {
        # 空白を除去
        $input =~ s/\s+//g;
        die "パースエラー: 空文字列" if $input eq '';

        return $self->_parse_additive($input);
    }

    sub _parse_additive($self, $input) {
        # +または-で分割（最後の演算子を探す）
        if ($input =~ /^(.+)([\+\-])([^\+\-]+)$/) {
            my ($left, $op, $right) = ($1, $2, $3);
            my $left_expr  = $self->_parse_additive($left);
            my $right_expr = $self->_parse_multiplicative($right);

            return $op eq '+'
                ? AddExpr->new(left => $left_expr, right => $right_expr)
                : SubExpr->new(left => $left_expr, right => $right_expr);
        }
        return $self->_parse_multiplicative($input);
    }

    sub _parse_multiplicative($self, $input) {
        # *で分割
        if ($input =~ /^(.+)\*([^\*]+)$/) {
            my ($left, $right) = ($1, $2);
            my $left_expr  = $self->_parse_multiplicative($left);
            my $right_expr = $self->_parse_primary($right);
            return MulExpr->new(left => $left_expr, right => $right_expr);
        }
        return $self->_parse_primary($input);
    }

    sub _parse_primary($self, $input) {
        # ダイス記法: NdM
        if ($input =~ /^(\d+)d(\d+)$/) {
            return DiceExpr->new(count => $1, sides => $2);
        }
        # 数値
        if ($input =~ /^(\d+)$/) {
            return NumberExpr->new(value => $1);
        }
        die "パースエラー: $input";
    }
}

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102

#!/usr/bin/env perl
use v5.36;

package ExpressionRole {
    use Moo::Role;
    requires 'eval';
}

package NumberExpr {
    use Moo;
    with 'ExpressionRole';
    has value => (is => 'ro', required => 1);
    sub eval($self) { return $self->value; }
}

package DiceExpr {
    use Moo;
    with 'ExpressionRole';
    has count => (is => 'ro', required => 1);
    has sides => (is => 'ro', required => 1);
    sub eval($self) {
        my $total = 0;
        for (1 .. $self->count) {
            $total += int(rand($self->sides)) + 1;
        }
        return $total;
    }
}

package AddExpr {
    use Moo;
    with 'ExpressionRole';
    has left  => (is => 'ro', required => 1);
    has right => (is => 'ro', required => 1);
    sub eval($self) { return $self->left->eval + $self->right->eval; }
}

package SubExpr {
    use Moo;
    with 'ExpressionRole';
    has left  => (is => 'ro', required => 1);
    has right => (is => 'ro', required => 1);
    sub eval($self) { return $self->left->eval - $self->right->eval; }
}

package MulExpr {
    use Moo;
    with 'ExpressionRole';
    has left  => (is => 'ro', required => 1);
    has right => (is => 'ro', required => 1);
    sub eval($self) { return $self->left->eval * $self->right->eval; }
}

package DiceParser {
    use Moo;

    sub parse($self, $input) {
        $input =~ s/\s+//g;
        die "パースエラー: 空文字列" if $input eq '';
        return $self->_parse_additive($input);
    }

    sub _parse_additive($self, $input) {
        if ($input =~ /^(.+)([\+\-])([^\+\-]+)$/) {
            my ($left, $op, $right) = ($1, $2, $3);
            my $left_expr  = $self->_parse_additive($left);
            my $right_expr = $self->_parse_multiplicative($right);
            return $op eq '+'
                ? AddExpr->new(left => $left_expr, right => $right_expr)
                : SubExpr->new(left => $left_expr, right => $right_expr);
        }
        return $self->_parse_multiplicative($input);
    }

    sub _parse_multiplicative($self, $input) {
        if ($input =~ /^(.+)\*([^\*]+)$/) {
            my ($left, $right) = ($1, $2);
            return MulExpr->new(
                left  => $self->_parse_multiplicative($left),
                right => $self->_parse_primary($right),
            );
        }
        return $self->_parse_primary($input);
    }

    sub _parse_primary($self, $input) {
        return DiceExpr->new(count => $1, sides => $2) if $input =~ /^(\d+)d(\d+)$/;
        return NumberExpr->new(value => $1) if $input =~ /^(\d+)$/;
        die "パースエラー: $input";
    }
}

# ダイス言語インタプリタを使う
my $parser = DiceParser->new;

my @expressions = ('2d6', '2d6+3', '3d8-5', '1d20*2', '2d6+3*2');

for my $input (@expressions) {
    my $expr   = $parser->parse($input);
    my $result = $expr->eval;
    say "$input = $result";
}