view release on metacpan or  search on metacpan

lib/Affix.pm  view on Meta::CPAN

                    my $is_value = 0;
                    if ( defined $next && !ref $next ) {
                        if ( $next =~ /^-?\d+$/ || $next =~ /^0x[0-9a-fA-F]+$/ || $next =~ /[\+\|\-\*\/\<\>\~\!\^\(\)]/ ) {
                            $is_value = 1;
                        }
                        elsif ( exists $self->{const_map}->{$next} ) {
                            $is_value = 1;
                        }
                    }
                    if ($is_value) {
                        if ( $next =~ /^-?\d+$/ ) {
                            $final_val = $next;
                        }
                        elsif ( $next =~ /^0x[0-9a-fA-F]+$/ ) {
                            $final_val = hex($next);
                        }
                        else {
                            $final_val = $self->_calculate_expr( $next, $self->{const_map} );
                        }
                        $i++;
                    }
                    else {
                        $final_val = $counter;
                    }
                }
                elsif ( ref $item eq 'ARRAY' ) {
                    my $raw_val;
                    ( $name, $raw_val ) = @$item;
                    if ( $raw_val =~ /^-?\d+$/ ) {
                        $final_val = $raw_val;
                    }
                    elsif ( $raw_val =~ /^0x[0-9a-fA-F]+$/ ) {
                        $final_val = hex($raw_val);
                    }
                    else {
                        $final_val = $self->_calculate_expr( $raw_val, $self->{const_map} );
                    }
                }
                else {
                    Carp::croak("Enum elements must be Strings or [Name => Value] ArrayRefs");
                }
                $self->{const_map}->{$name} = $final_val;
                $self->{values_map}->{$final_val} //= $name;
                $counter = $final_val + 1;
            }
            return ( $self->{const_map}, $self->{values_map} );
        }

        sub _calculate_expr {
            my ( $self, $expr, $lookup ) = @_;
            use integer;
            my @tokens = $expr =~ /(0x[0-9a-fA-F]+|\d+|[a-zA-Z_]\w*|<<|>>|&&|\|\||==|!=|<=|>=|[+\-*\/%|&^~!?:()<>])/g;
            for my $t (@tokens) {
                next if $t =~ /^(?:<<|>>|&&|\|\||==|!=|<=|>=|[+\-*\/%|&^~!?:()<>])$/;
                next if $t =~ /^\d+$/;
                next if $t =~ /^0x/;
                if ( exists $lookup->{$t} ) {
                    $t = $lookup->{$t};
                }
                else {
                    Carp::croak("Enum definition error: Unknown symbol '$t' in expression '$expr'");
                }
                $t = hex($t) if $t =~ /^0x/;
            }
            my @output_queue;
            my @op_stack;
            my %prec = (
                '*'           => [ 13, 1 ],
                '/'           => [ 13, 1 ],
                '%'           => [ 13, 1 ],
                '+'           => [ 12, 1 ],
                '-'           => [ 12, 1 ],
                '<<'          => [ 11, 1 ],
                '>>'          => [ 11, 1 ],
                '<'           => [ 10, 1 ],
                '<='          => [ 10, 1 ],
                '>'           => [ 10, 1 ],
                '>='          => [ 10, 1 ],
                '=='          => [ 9,  1 ],
                '!='          => [ 9,  1 ],
                '&'           => [ 8,  1 ],
                '^'           => [ 7,  1 ],
                '|'           => [ 6,  1 ],
                '&&'          => [ 5,  1 ],
                '||'          => [ 4,  1 ],
                '?'           => [ 3,  0 ],
                ':'           => [ 3,  0 ],
                'unary_plus'  => [ 14, 0 ],
                'unary_minus' => [ 14, 0 ],
                '!'           => [ 14, 0 ],
                '~'           => [ 14, 0 ],
                '('           => [ -1, 0 ]
            );
            my $expect_unary = 1;
            for my $token (@tokens) {
                if    ( $token =~ /^\d+$/ ) { push @output_queue, $token; $expect_unary = 0; }
                elsif ( $token eq '(' )     { push @op_stack,     $token; $expect_unary = 1; }
                elsif ( $token eq ')' ) {
                    while ( @op_stack && $op_stack[-1] ne '(' ) { push @output_queue, pop @op_stack; }
                    pop @op_stack;
                    $expect_unary = 0;
                }
                elsif ( $token eq '?' ) {
                    while ( @op_stack && $op_stack[-1] ne '(' && $prec{ $op_stack[-1] }[0] > $prec{$token}[0] ) { push @output_queue, pop @op_stack; }
                    push @op_stack, $token;
                    $expect_unary = 1;
                }
                elsif ( $token eq ':' ) {
                    while ( @op_stack && $op_stack[-1] ne '?' ) { push @output_queue, pop @op_stack; }
                    $expect_unary = 1;
                }
                else {
                    if ( $expect_unary && ( $token eq '+' || $token eq '-' || $token eq '!' || $token eq '~' ) ) {
                        $token = $token eq '+' ? 'unary_plus' : $token eq '-' ? 'unary_minus' : $token;
                    }
                    elsif ( !exists $prec{$token} ) { Carp::croak("Unknown token '$token'"); }
                    my $p1    = $prec{$token}[0];
                    my $assoc = $prec{$token}[1];
                    while (@op_stack) {
                        my $top = $op_stack[-1];
                        last if $top eq '(';