view release on metacpan or  search on metacpan

lib/Affix.pm  view on Meta::CPAN

        sub signature { shift->{name} }
    }
    package    #
        Affix::Type::Bitfield {
        our @ISA = qw[Affix::Type];
        sub signature { my $self = shift; $self->{type}->signature . ':' . $self->{width} }
    }
    package    #
        Affix::Type::Enum {
        our @ISA = qw[Affix::Type];
        use Carp;
        sub signature { 'e:' . shift->{type} }

        sub resolve {
            my $self = shift;
            return ( $self->{const_map}, $self->{values_map} ) if defined $self->{values_map};
            $self->{const_map}  = {};
            $self->{values_map} = {};
            my $counter = 0;
            for my $item ( @{ $self->{elements} } ) {
                my ( $name, $final_val );
                if ( !ref $item ) {
                    $name      = $item;
                    $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 '(';