ANTLR/Runtime/BitSet.pm

package ANTLR::Runtime::BitSet;

use Carp;
use Readonly;
use List::Util qw( max );

use Moose;
use Moose::Util::TypeConstraints;

use overload
    '|=' => \&or_in_place,
    '""' => \&str;

# number of bits / long
Readonly my $BITS => 64;
sub BITS { return $BITS }

# 2^6 == 64
Readonly my $LOG_BITS => 6;
sub LOG_BITS { return $LOG_BITS }

# We will often need to do a mod operator (i mod nbits).  Its
# turns out that, for powers of two, this mod operation is
# same as (i & (nbits-1)).  Since mod is slow, we use a
# precomputed mod mask to do the mod instead.
Readonly my $MOD_MASK => BITS - 1;
sub MOD_MASK { return $MOD_MASK }

# The actual data bit
has 'bits' => (
    is  => 'rw',
    isa => subtype 'Str' => where { /^(?:0|1)*$/xms },
);

sub trim_hex {
    my ($number) = @_;

    $number =~ s/^0x//xms;

    return $number;
}

sub BUILD {
    my ($self, $args) = @_;

    my $bits;
    if (!%$args) {  ## no critic (ControlStructures::ProhibitCascadingIfElse)
        # Construct a bitset of size one word (64 bits)
        $bits = '0' x BITS;
    }
    elsif (exists $args->{bits}) {
        $bits = $args->{bits};
    }
    elsif (exists $args->{number}) {
        $bits = reverse unpack('B*', pack('N', $args->{number}));
    }
    elsif (exists $args->{words64}) {
        # Construction from a static array of longs
        my $words64 = $args->{words64};

        # $number is in hex format
        my $number = join '',
            map { trim_hex($_) }
            reverse @$words64;

        $bits = '';
        foreach my $h (split //xms, reverse $number) {
            $bits .= reverse substr(unpack('B*', pack('h', hex $h)), 4);
        }
    }
    elsif (exists $args->{''}) {
       # Construction from a list of integers
    }
    elsif (exists $args->{size}) {
        # Construct a bitset given the size
        $bits = '0' x $args->{size};
    }
    else {
        croak 'Invalid argument';
    }

    $self->bits($bits);
    return;
}

sub of {
    my ($class, $el) = @_;

    my $bs = ANTLR::Runtime::BitSet->new({ size => $el + 1 });
    $bs->add($el);

    return $bs;
}

sub or : method {  ## no critic (Subroutines::ProhibitBuiltinHomonyms)
    my ($self, $a) = @_;

    if (!defined $a) {
        return $self;
    }

    my $s = $self->clone();
    $s->or_in_place($a);
    return $s;
}

sub add : method {
    my ($self, $el) = @_;

    $self->grow_to_include($el);
    my $bits = $self->bits;
    substr($bits, $el, 1, '1');
    $self->bits($bits);

    return;
}

sub grow_to_include : method {
    my ($self, $bit) = @_;

    if ($bit > length $self->bits) {
        $self->bits .= '0' x ($bit - (length $self->bits) + 1);
    }

    return;
}

sub or_in_place : method {
    my ($self, $a) = @_;

    my $i = 0;
    foreach my $b (split //xms, $a->bits) {
        if ($b) {
            $self->add($i);
        }
    } continue {
        ++$i;
    }

    return $self;
}

sub clone : method {
    my ($self) = @_;

    return ANTLR::Runtime::BitSet->new(bits => $self->bits);
}

sub size : method {
    my ($self) = @_;

    return scalar $self->bits =~ /1/xms;
}

sub equals : method {
    my ($self, $other) = @_;

    return $self->bits eq $other->bits;
}

sub member : method {
    my ($self, $el) = @_;

    return (substr $self->bits, $el, 1) eq '1';
}

sub remove : method {
    my ($self, $el) = @_;

    my $bits = $self->bits;
    substr($bits, $el, 1, '0');
    $self->bits($bits);

    return;
}

sub is_nil : method {
    my ($self) = @_;

    return $self->bits =~ /1/xms ? 1 : 0;
}

sub num_bits : method {
    my ($self) = @_;
    return length $self->bits;
}

sub length_in_long_words : method {
    my ($self) = @_;
    return $self->num_bits() / $self->BITS;
}

sub to_array : method {
    my ($self) = @_;

    my $elems = [];

    while ($self->bits =~ /1/gxms) {
        push @$elems, $-[0];
    }

    return $elems;
}

sub to_packed_array : method {
    my ($self) = @_;

    return [
        $self->bits =~ /.{BITS}/gxms
    ];
}

sub str : method {
    my ($self) = @_;

    return $self->to_string();
}

sub to_string : method {
    my ($self, $args) = @_;

    my $token_names;
    if (defined $args && exists $args->{token_names}) {
        $token_names = $args->{token_names};
    }

    my @str;
    my $i = 0;
    foreach my $b (split //xms, $self->bits) {
        if ($b) {
            if (defined $token_names) {
                push @str, $token_names->[$i];
            } else {
                push @str, $i;
            }
        }
    } continue {
        ++$i;
    }

    return '{' . (join ',', @str) . '}';
}

no Moose;
__PACKAGE__->meta->make_immutable();
1;
__END__


=head1 NAME

ANTLR::Runtime::BitSet - A bit set


=head1 SYNOPSIS

    use <Module::Name>;
    # Brief but working code example(s) here showing the most common usage(s)

    # This section will be as far as many users bother reading
    # so make it as educational and exemplary as possible.


=head1 DESCRIPTION

A stripped-down version of org.antlr.misc.BitSet that is just good enough to
handle runtime requirements such as FOLLOW sets for automatic error recovery.


=head1 SUBROUTINES/METHODS

=over

=item C<of>

...

=item C<or>

Return this | a in a new set.

=item C<add>

Or this element into this set (grow as necessary to accommodate).

=item C<grow_to_include>

Grows the set to a larger number of bits.

=item C<set_size>

Sets the size of a set.

=item C<remove>

Remove this element from this set.

=item C<length_in_long_words>

Return how much space is being used by the bits array not how many actually
have member bits on.

=back

A separate section listing the public components of the module's interface.
These normally consist of either subroutines that may be exported, or methods
that may be called on objects belonging to the classes that the module provides.
Name the section accordingly.

In an object-oriented module, this section should begin with a sentence of the
form "An object of this class represents...", to give the reader a high-level
context to help them understand the methods that are subsequently described.


=head1 DIAGNOSTICS

A list of every error and warning message that the module can generate
(even the ones that will "never happen"), with a full explanation of each
problem, one or more likely causes, and any suggested remedies.
(See also "Documenting Errors" in Chapter 13.)


=head1 CONFIGURATION AND ENVIRONMENT

A full explanation of any configuration system(s) used by the module,
including the names and locations of any configuration files, and the
meaning of any environment variables or properties that can be set. These
descriptions must also include details of any configuration language used.
(See also "Configuration Files" in Chapter 19.)


=head1 DEPENDENCIES

A list of all the other modules that this module relies upon, including any
restrictions on versions, and an indication whether these required modules are
part of the standard Perl distribution, part of the module's distribution,
or must be installed separately.


=head1 INCOMPATIBILITIES

A list of any modules that this module cannot be used in conjunction with.
This may be due to name conflicts in the interface, or competition for
system or program resources, or due to internal limitations of Perl
(for example, many modules that use source code filters are mutually
incompatible).