1package ANTLR::Runtime::BitSet; 2 3use Carp; 4use Readonly; 5use List::Util qw( max ); 6 7use Moose; 8use Moose::Util::TypeConstraints; 9 10use overload 11 '|=' => \&or_in_place, 12 '""' => \&str; 13 14# number of bits / long 15Readonly my $BITS => 64; 16sub BITS { return $BITS } 17 18# 2^6 == 64 19Readonly my $LOG_BITS => 6; 20sub LOG_BITS { return $LOG_BITS } 21 22# We will often need to do a mod operator (i mod nbits). Its 23# turns out that, for powers of two, this mod operation is 24# same as (i & (nbits-1)). Since mod is slow, we use a 25# precomputed mod mask to do the mod instead. 26Readonly my $MOD_MASK => BITS - 1; 27sub MOD_MASK { return $MOD_MASK } 28 29# The actual data bit 30has 'bits' => ( 31 is => 'rw', 32 isa => subtype 'Str' => where { /^(?:0|1)*$/xms }, 33); 34 35sub trim_hex { 36 my ($number) = @_; 37 38 $number =~ s/^0x//xms; 39 40 return $number; 41} 42 43sub BUILD { 44 my ($self, $args) = @_; 45 46 my $bits; 47 if (!%$args) { ## no critic (ControlStructures::ProhibitCascadingIfElse) 48 # Construct a bitset of size one word (64 bits) 49 $bits = '0' x BITS; 50 } 51 elsif (exists $args->{bits}) { 52 $bits = $args->{bits}; 53 } 54 elsif (exists $args->{number}) { 55 $bits = reverse unpack('B*', pack('N', $args->{number})); 56 } 57 elsif (exists $args->{words64}) { 58 # Construction from a static array of longs 59 my $words64 = $args->{words64}; 60 61 # $number is in hex format 62 my $number = join '', 63 map { trim_hex($_) } 64 reverse @$words64; 65 66 $bits = ''; 67 foreach my $h (split //xms, reverse $number) { 68 $bits .= reverse substr(unpack('B*', pack('h', hex $h)), 4); 69 } 70 } 71 elsif (exists $args->{''}) { 72 # Construction from a list of integers 73 } 74 elsif (exists $args->{size}) { 75 # Construct a bitset given the size 76 $bits = '0' x $args->{size}; 77 } 78 else { 79 croak 'Invalid argument'; 80 } 81 82 $self->bits($bits); 83 return; 84} 85 86sub of { 87 my ($class, $el) = @_; 88 89 my $bs = ANTLR::Runtime::BitSet->new({ size => $el + 1 }); 90 $bs->add($el); 91 92 return $bs; 93} 94 95sub or : method { ## no critic (Subroutines::ProhibitBuiltinHomonyms) 96 my ($self, $a) = @_; 97 98 if (!defined $a) { 99 return $self; 100 } 101 102 my $s = $self->clone(); 103 $s->or_in_place($a); 104 return $s; 105} 106 107sub add : method { 108 my ($self, $el) = @_; 109 110 $self->grow_to_include($el); 111 my $bits = $self->bits; 112 substr($bits, $el, 1, '1'); 113 $self->bits($bits); 114 115 return; 116} 117 118sub grow_to_include : method { 119 my ($self, $bit) = @_; 120 121 if ($bit > length $self->bits) { 122 $self->bits .= '0' x ($bit - (length $self->bits) + 1); 123 } 124 125 return; 126} 127 128sub or_in_place : method { 129 my ($self, $a) = @_; 130 131 my $i = 0; 132 foreach my $b (split //xms, $a->bits) { 133 if ($b) { 134 $self->add($i); 135 } 136 } continue { 137 ++$i; 138 } 139 140 return $self; 141} 142 143sub clone : method { 144 my ($self) = @_; 145 146 return ANTLR::Runtime::BitSet->new(bits => $self->bits); 147} 148 149sub size : method { 150 my ($self) = @_; 151 152 return scalar $self->bits =~ /1/xms; 153} 154 155sub equals : method { 156 my ($self, $other) = @_; 157 158 return $self->bits eq $other->bits; 159} 160 161sub member : method { 162 my ($self, $el) = @_; 163 164 return (substr $self->bits, $el, 1) eq '1'; 165} 166 167sub remove : method { 168 my ($self, $el) = @_; 169 170 my $bits = $self->bits; 171 substr($bits, $el, 1, '0'); 172 $self->bits($bits); 173 174 return; 175} 176 177sub is_nil : method { 178 my ($self) = @_; 179 180 return $self->bits =~ /1/xms ? 1 : 0; 181} 182 183sub num_bits : method { 184 my ($self) = @_; 185 return length $self->bits; 186} 187 188sub length_in_long_words : method { 189 my ($self) = @_; 190 return $self->num_bits() / $self->BITS; 191} 192 193sub to_array : method { 194 my ($self) = @_; 195 196 my $elems = []; 197 198 while ($self->bits =~ /1/gxms) { 199 push @$elems, $-[0]; 200 } 201 202 return $elems; 203} 204 205sub to_packed_array : method { 206 my ($self) = @_; 207 208 return [ 209 $self->bits =~ /.{BITS}/gxms 210 ]; 211} 212 213sub str : method { 214 my ($self) = @_; 215 216 return $self->to_string(); 217} 218 219sub to_string : method { 220 my ($self, $args) = @_; 221 222 my $token_names; 223 if (defined $args && exists $args->{token_names}) { 224 $token_names = $args->{token_names}; 225 } 226 227 my @str; 228 my $i = 0; 229 foreach my $b (split //xms, $self->bits) { 230 if ($b) { 231 if (defined $token_names) { 232 push @str, $token_names->[$i]; 233 } else { 234 push @str, $i; 235 } 236 } 237 } continue { 238 ++$i; 239 } 240 241 return '{' . (join ',', @str) . '}'; 242} 243 244no Moose; 245__PACKAGE__->meta->make_immutable(); 2461; 247__END__ 248 249 250=head1 NAME 251 252ANTLR::Runtime::BitSet - A bit set 253 254 255=head1 SYNOPSIS 256 257 use <Module::Name>; 258 # Brief but working code example(s) here showing the most common usage(s) 259 260 # This section will be as far as many users bother reading 261 # so make it as educational and exemplary as possible. 262 263 264=head1 DESCRIPTION 265 266A stripped-down version of org.antlr.misc.BitSet that is just good enough to 267handle runtime requirements such as FOLLOW sets for automatic error recovery. 268 269 270=head1 SUBROUTINES/METHODS 271 272=over 273 274=item C<of> 275 276... 277 278=item C<or> 279 280Return this | a in a new set. 281 282=item C<add> 283 284Or this element into this set (grow as necessary to accommodate). 285 286=item C<grow_to_include> 287 288Grows the set to a larger number of bits. 289 290=item C<set_size> 291 292Sets the size of a set. 293 294=item C<remove> 295 296Remove this element from this set. 297 298=item C<length_in_long_words> 299 300Return how much space is being used by the bits array not how many actually 301have member bits on. 302 303=back 304 305A separate section listing the public components of the module's interface. 306These normally consist of either subroutines that may be exported, or methods 307that may be called on objects belonging to the classes that the module provides. 308Name the section accordingly. 309 310In an object-oriented module, this section should begin with a sentence of the 311form "An object of this class represents...", to give the reader a high-level 312context to help them understand the methods that are subsequently described. 313 314 315=head1 DIAGNOSTICS 316 317A list of every error and warning message that the module can generate 318(even the ones that will "never happen"), with a full explanation of each 319problem, one or more likely causes, and any suggested remedies. 320(See also "Documenting Errors" in Chapter 13.) 321 322 323=head1 CONFIGURATION AND ENVIRONMENT 324 325A full explanation of any configuration system(s) used by the module, 326including the names and locations of any configuration files, and the 327meaning of any environment variables or properties that can be set. These 328descriptions must also include details of any configuration language used. 329(See also "Configuration Files" in Chapter 19.) 330 331 332=head1 DEPENDENCIES 333 334A list of all the other modules that this module relies upon, including any 335restrictions on versions, and an indication whether these required modules are 336part of the standard Perl distribution, part of the module's distribution, 337or must be installed separately. 338 339 340=head1 INCOMPATIBILITIES 341 342A list of any modules that this module cannot be used in conjunction with. 343This may be due to name conflicts in the interface, or competition for 344system or program resources, or due to internal limitations of Perl 345(for example, many modules that use source code filters are mutually 346incompatible). 347