347 lines
7.2 KiB
Perl
347 lines
7.2 KiB
Perl
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).
|