• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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