| package ANTLR::Runtime::CommonTokenStream; |
| |
| use Carp; |
| use Readonly; |
| use UNIVERSAL qw( isa ); |
| |
| use ANTLR::Runtime::CharStream; |
| use ANTLR::Runtime::Token; |
| use ANTLR::Runtime::TokenSource; |
| |
| use Moose; |
| |
| use overload |
| '""' => \&str |
| ; |
| |
| with 'ANTLR::Runtime::IntStream', |
| 'ANTLR::Runtime::TokenStream'; |
| |
| has 'token_source' => ( |
| is => 'rw', |
| does => 'ANTLR::Runtime::TokenSource', |
| ); |
| |
| has 'tokens' => ( |
| is => 'rw', |
| isa => 'ArrayRef[ANTLR::Runtime::Token]', |
| default => sub { [] }, |
| ); |
| |
| has 'channel_override_map' => ( |
| is => 'rw', |
| isa => 'HashRef[Int]', |
| ); |
| |
| has 'discard_set' => ( |
| is => 'rw', |
| isa => 'HashRef[Int]', |
| ); |
| |
| has 'channel' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => ANTLR::Runtime::Token->DEFAULT_CHANNEL, |
| ); |
| |
| has 'discard_off_channel_tokens' => ( |
| is => 'rw', |
| isa => 'Bool', |
| default => 0, |
| ); |
| |
| has 'last_marker' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 0, |
| ); |
| |
| has 'p' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => -1, |
| ); |
| |
| sub set_token_source { |
| my ($self, $token_source) = @_; |
| |
| $self->token_source($token_source); |
| $self->tokens([]); |
| $self->p(-1); |
| $self->channel(ANTLR::Runtime::Token->DEFAULT_CHANNEL); |
| } |
| |
| sub fill_buffer { |
| my ($self) = @_; |
| |
| my $index = 0; |
| my $t = $self->token_source->next_token(); |
| while (defined $t && $t->get_type() != ANTLR::Runtime::CharStream->EOF) { |
| my $discard = 0; |
| # is there a channel override for token type? |
| if (defined $self->channel_override_map) { |
| my $channel = $self->channel_override_map->{$t->get_type()}; |
| if (defined $channel) { |
| $t->set_channel($channel); |
| } |
| } |
| |
| if (defined $self->discard_set && $self->discard_set->contains($t->get_type())) { |
| $discard = 1; |
| } elsif ($self->discard_off_channel_tokens && $t->get_channel() != $self->channel) { |
| $discard = 1; |
| } |
| |
| if (!$discard) { |
| $t->set_token_index($index); |
| push @{$self->tokens}, $t; |
| ++$index; |
| } |
| } continue { |
| $t = $self->token_source->next_token(); |
| } |
| |
| # leave p pointing at first token on channel |
| $self->p(0); |
| $self->skip_off_token_channels($self->p); |
| } |
| |
| sub consume { |
| my ($self) = @_; |
| |
| if ($self->p < @{$self->tokens}) { |
| $self->p($self->p + 1); |
| $self->p($self->skip_off_token_channels($self->p)); # leave p on valid token |
| } |
| } |
| |
| sub skip_off_token_channels { |
| my ($self, $i) = @_; |
| |
| my $n = @{$self->tokens}; |
| while ($i < $n && $self->tokens->[$i]->get_channel() != $self->channel) { |
| ++$i; |
| } |
| |
| return $i; |
| } |
| |
| sub skip_off_token_channels_reverse { |
| my ($self, $i) = @_; |
| |
| while ($i >= 0 && $self->tokens->[$i]->get_channel() != $self->channel) { |
| --$i; |
| } |
| |
| return $i; |
| } |
| |
| sub set_token_type_channel { |
| my ($self, $ttype, $channel) = @_; |
| |
| if (!defined $self->channel_override_map) { |
| $self->channel_override_map({}); |
| } |
| |
| $self->channel_override_map->{$ttype} = $channel; |
| } |
| |
| sub discard_token_type { |
| my ($self, $ttype) = @_; |
| |
| if (!defined $self->discard_set) { |
| $self->discard_set({}); |
| } |
| |
| $self->discard_set->{$ttype} = 1; |
| } |
| |
| sub get_tokens { |
| my ($self, $args) = @_; |
| |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| if (!defined $args) { |
| return $self->tokens; |
| } |
| |
| my $start = $args->{start}; |
| my $stop = $args->{stop}; |
| |
| my $types; |
| if (exists $args->{types}) { |
| if (ref $args->{types} eq 'ARRAY') { |
| $types = ANTLR::Runtime::BitSet->new($args->{types}); |
| } else { |
| $types = $args->{types}; |
| } |
| } else { |
| my $ttype = $args->{ttype}; |
| $types = ANTLR::Runtime::BitSet->of($ttype); |
| } |
| |
| |
| if ($stop >= @{$self->tokens}) { |
| $stop = $#{$self->tokens}; |
| } |
| if ($start < 0) { |
| $start = 0; |
| } |
| |
| if ($start > $stop) { |
| return undef; |
| } |
| |
| my $filtered_tokens = []; |
| foreach my $t (@{$self->tokens}[$start..$stop]) { |
| if (!defined $types || $types->member($t->get_type())) { |
| push @$filtered_tokens, $t; |
| } |
| } |
| |
| if (!@{$filtered_tokens}) { |
| $filtered_tokens = undef; |
| } |
| |
| return $filtered_tokens; |
| } |
| |
| sub LT { |
| my ($self, $k) = @_; |
| |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| if ($k == 0) { |
| return undef; |
| } |
| if ($k < 0) { |
| return $self->LB(-$k); |
| } |
| |
| if ($self->p + $k - 1 >= @{$self->tokens}) { |
| return ANTLR::Runtime::Token->EOF_TOKEN; |
| } |
| |
| my $i = $self->p; |
| my $n = 1; |
| |
| while ($n < $k) { |
| $i = $self->skip_off_token_channels($i+1); |
| ++$n; |
| } |
| |
| if ($i >= @{$self->tokens}) { |
| return ANTLR::Runtime::Token->EOF_TOKEN; |
| } |
| |
| return $self->tokens->[$i]; |
| } |
| |
| sub LB { |
| my ($self, $k) = @_; |
| |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| if ($k == 0) { |
| return undef; |
| } |
| if ($self->p - $k < 0) { |
| return undef; |
| } |
| |
| my $i = $self->p; |
| my $n = 1; |
| while ($n <= $k) { |
| $k = $self->skip_off_token_channels_reverse($i - 1); |
| ++$n; |
| } |
| |
| if ($i < 0) { |
| return undef; |
| } |
| |
| return $self->tokens->[$i]; |
| } |
| |
| sub get { |
| my ($self, $i) = @_; |
| |
| return $self->tokens->[$i]; |
| } |
| |
| sub LA { |
| my ($self, $i) = @_; |
| |
| return $self->LT($i)->get_type(); |
| } |
| |
| sub mark { |
| my ($self) = @_; |
| |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| $self->last_marker($self->index()); |
| return $self->last_marker; |
| } |
| |
| sub release { |
| my ($self, $marker) = @_; |
| |
| # no resources to release |
| } |
| |
| sub size { |
| my ($self) = @_; |
| |
| return scalar @{$self->tokens}; |
| } |
| |
| sub index { |
| my ($self) = @_; |
| |
| return $self->p; |
| } |
| |
| sub rewind { |
| Readonly my $usage => 'void rewind(int marker) | void rewind()'; |
| croak $usage if @_ != 1 && @_ != 2; |
| |
| if (@_ == 1) { |
| my ($self) = @_; |
| $self->seek($self->last_marker); |
| } else { |
| my ($self, $marker) = @_; |
| $self->seek($marker); |
| } |
| } |
| |
| sub seek { |
| my ($self, $index) = @_; |
| |
| $self->p($index); |
| } |
| |
| sub get_token_source { |
| my ($self) = @_; |
| |
| return $self->token_source; |
| } |
| |
| sub get_source_name { |
| my ($self) = @_; |
| return $self->get_token_source()->get_source_name(); |
| } |
| |
| sub str { |
| my ($self) = @_; |
| return $self->to_string(); |
| } |
| |
| sub to_string { |
| Readonly my $usage => 'String to_string() | String to_string(int start, int stop | String to_string(Token start, Token stop)'; |
| croak $usage if @_ != 1 && @_ != 3; |
| |
| if (@_ == 1) { |
| my ($self) = @_; |
| |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| return $self->to_string(0, $#{$self->tokens}); |
| } else { |
| my ($self, $start, $stop) = @_; |
| |
| if (defined $start && defined $stop) { |
| if (ref($start) && $start->isa('ANTLR::Runtime::Token')) { |
| $start = $start->get_token_index(); |
| } |
| |
| if (ref($start) && $stop->isa('ANTLR::Runtime::Token')) { |
| $stop = $stop->get_token_index(); |
| } |
| |
| if ($start < 0 || $stop < 0) { |
| return undef; |
| } |
| if ($self->p == -1) { |
| $self->fill_buffer(); |
| } |
| if ($stop >= @{$self->tokens}) { |
| $stop = $#{$self->tokens}; |
| } |
| |
| my $buf = ''; |
| foreach my $t (@{$self->tokens}[$start..$stop]) { |
| $buf .= $t->get_text(); |
| } |
| |
| return $buf; |
| } else { |
| return undef; |
| } |
| } |
| } |
| |
| no Moose; |
| __PACKAGE__->meta->make_immutable(); |
| 1; |
| __END__ |