1 package ANTLR::Runtime::BitSet; 2 3 use Carp; 4 use Readonly; 5 use List::Util qw( max ); 6 7 use Moose; 8 use Moose::Util::TypeConstraints; 9 10 use overload 11 '|=' => \&or_in_place, 12 '""' => \&str; 13 14 # number of bits / long 15 Readonly my $BITS => 64; 16 sub BITS { return $BITS } 17 18 # 2^6 == 64 19 Readonly my $LOG_BITS => 6; 20 sub 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. 26 Readonly my $MOD_MASK => BITS - 1; 27 sub MOD_MASK { return $MOD_MASK } 28 29 # The actual data bit 30 has 'bits' => ( 31 is => 'rw', 32 isa => subtype 'Str' => where { /^(?:0|1)*$/xms }, 33 ); 34 35 sub trim_hex { 36 my ($number) = @_; 37 38 $number =~ s/^0x//xms; 39 40 return $number; 41 } 42 43 sub 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 86 sub 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 95 sub 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 107 sub 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 118 sub 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 128 sub 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 143 sub clone : method { 144 my ($self) = @_; 145 146 return ANTLR::Runtime::BitSet->new(bits => $self->bits); 147 } 148 149 sub size : method { 150 my ($self) = @_; 151 152 return scalar $self->bits =~ /1/xms; 153 } 154 155 sub equals : method { 156 my ($self, $other) = @_; 157 158 return $self->bits eq $other->bits; 159 } 160 161 sub member : method { 162 my ($self, $el) = @_; 163 164 return (substr $self->bits, $el, 1) eq '1'; 165 } 166 167 sub 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 177 sub is_nil : method { 178 my ($self) = @_; 179 180 return $self->bits =~ /1/xms ? 1 : 0; 181 } 182 183 sub num_bits : method { 184 my ($self) = @_; 185 return length $self->bits; 186 } 187 188 sub length_in_long_words : method { 189 my ($self) = @_; 190 return $self->num_bits() / $self->BITS; 191 } 192 193 sub 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 205 sub to_packed_array : method { 206 my ($self) = @_; 207 208 return [ 209 $self->bits =~ /.{BITS}/gxms 210 ]; 211 } 212 213 sub str : method { 214 my ($self) = @_; 215 216 return $self->to_string(); 217 } 218 219 sub 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 244 no Moose; 245 __PACKAGE__->meta->make_immutable(); 246 1; 247 __END__ 248 249 250 =head1 NAME 251 252 ANTLR::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 266 A stripped-down version of org.antlr.misc.BitSet that is just good enough to 267 handle 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 280 Return this | a in a new set. 281 282 =item C<add> 283 284 Or this element into this set (grow as necessary to accommodate). 285 286 =item C<grow_to_include> 287 288 Grows the set to a larger number of bits. 289 290 =item C<set_size> 291 292 Sets the size of a set. 293 294 =item C<remove> 295 296 Remove this element from this set. 297 298 =item C<length_in_long_words> 299 300 Return how much space is being used by the bits array not how many actually 301 have member bits on. 302 303 =back 304 305 A separate section listing the public components of the module's interface. 306 These normally consist of either subroutines that may be exported, or methods 307 that may be called on objects belonging to the classes that the module provides. 308 Name the section accordingly. 309 310 In an object-oriented module, this section should begin with a sentence of the 311 form "An object of this class represents...", to give the reader a high-level 312 context to help them understand the methods that are subsequently described. 313 314 315 =head1 DIAGNOSTICS 316 317 A 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 319 problem, 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 325 A full explanation of any configuration system(s) used by the module, 326 including the names and locations of any configuration files, and the 327 meaning of any environment variables or properties that can be set. These 328 descriptions must also include details of any configuration language used. 329 (See also "Configuration Files" in Chapter 19.) 330 331 332 =head1 DEPENDENCIES 333 334 A list of all the other modules that this module relies upon, including any 335 restrictions on versions, and an indication whether these required modules are 336 part of the standard Perl distribution, part of the module's distribution, 337 or must be installed separately. 338 339 340 =head1 INCOMPATIBILITIES 341 342 A list of any modules that this module cannot be used in conjunction with. 343 This may be due to name conflicts in the interface, or competition for 344 system or program resources, or due to internal limitations of Perl 345 (for example, many modules that use source code filters are mutually 346 incompatible). 347
