| package ANTLR::Runtime::ANTLRStringStream; |
| |
| use Carp; |
| use Readonly; |
| |
| use ANTLR::Runtime::CharStreamState; |
| |
| use Moose; |
| |
| with 'ANTLR::Runtime::IntStream', 'ANTLR::Runtime::CharStream'; |
| |
| has 'input' => ( |
| is => 'ro', |
| isa => 'Str', |
| required => 1, |
| ); |
| |
| has 'p' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 0, |
| ); |
| |
| has 'line' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 1, |
| ); |
| |
| has 'char_position_in_line' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 0, |
| ); |
| |
| has 'mark_depth' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 0, |
| ); |
| |
| has 'markers' => ( |
| is => 'rw', |
| isa => 'ArrayRef[Maybe[ANTLR::Runtime::CharStreamState]]', |
| default => sub { [ undef ] }, |
| ); |
| |
| has 'last_marker' => ( |
| is => 'rw', |
| isa => 'Int', |
| default => 0, |
| ); |
| |
| has 'name' => ( |
| is => 'rw', |
| isa => 'Str', |
| default => q{}, |
| ); |
| |
| sub get_line { |
| my ($self) = @_; |
| return $self->line; |
| } |
| |
| sub set_line { |
| my ($self, $value) = @_; |
| $self->line($value); |
| return; |
| } |
| |
| sub get_char_position_in_line { |
| my ($self) = @_; |
| return $self->char_position_in_line; |
| } |
| |
| sub set_char_position_in_line { |
| my ($self, $value) = @_; |
| $self->char_position_in_line($value); |
| return; |
| } |
| |
| sub reset { |
| my ($self) = @_; |
| |
| $self->p(0); |
| $self->line(1); |
| $self->char_position_in_line(0); |
| $self->mark_depth(0); |
| return; |
| } |
| |
| sub consume { |
| my ($self) = @_; |
| |
| if ($self->p < length $self->input) { |
| $self->char_position_in_line($self->char_position_in_line + 1); |
| if (substr($self->input, $self->p, 1) eq "\n") { |
| $self->line($self->line + 1); |
| $self->char_position_in_line(0); |
| } |
| $self->p($self->p + 1); |
| } |
| return; |
| } |
| |
| sub LA { |
| my ($self, $i) = @_; |
| |
| if ($i == 0) { |
| return undef; |
| } |
| |
| if ($i < 0) { |
| ++$i; # e.g., translate LA(-1) to use offset i=0; then input[p+0-1] |
| if ($self->p + $i - 1 < 0) { |
| return $self->EOF; |
| } |
| } |
| |
| if ($self->p + $i - 1 >= length $self->input) { |
| return $self->EOF; |
| } |
| |
| return substr $self->input, $self->p + $i - 1, 1; |
| } |
| |
| sub LT { |
| my ($self, $i) = @_; |
| |
| return $self->LA($i); |
| } |
| |
| sub index { |
| my ($self) = @_; |
| |
| return $self->p; |
| } |
| |
| sub size { |
| my ($self) = @_; |
| |
| return length $self->input; |
| } |
| |
| sub mark { |
| my ($self) = @_; |
| |
| $self->mark_depth($self->mark_depth + 1); |
| my $state; |
| if ($self->mark_depth >= @{$self->markers}) { |
| $state = ANTLR::Runtime::CharStreamState->new(); |
| push @{$self->markers}, $state; |
| } else { |
| $state = $self->markers->[$self->mark_depth]; |
| } |
| |
| $state->set_p($self->p); |
| $state->set_line($self->line); |
| $state->set_char_position_in_line($self->char_position_in_line); |
| $self->last_marker($self->mark_depth); |
| |
| return $self->mark_depth; |
| } |
| |
| sub rewind { |
| my $self = shift; |
| my $m; |
| if (@_ == 0) { |
| $m = $self->last_marker; |
| } else { |
| $m = shift; |
| } |
| |
| my $state = $self->markers->[$m]; |
| # restore stream state |
| $self->seek($state->get_p); |
| $self->line($state->get_line); |
| $self->char_position_in_line($state->get_char_position_in_line); |
| $self->release($m); |
| return; |
| } |
| |
| sub release { |
| my ($self, $marker) = @_; |
| |
| # unwind any other markers made after m and release m |
| $self->mark_depth($marker); |
| # release this marker |
| $self->mark_depth($self->mark_depth - 1); |
| return; |
| } |
| |
| # consume() ahead unit p == index; can't just set p = index as we must update |
| # line and char_position_in_line |
| sub seek { |
| my ($self, $index) = @_; |
| |
| if ($index <= $self->p) { |
| # just jump; don't update stream state (line, ...) |
| $self->p($index); |
| return; |
| } |
| |
| # seek forward, consume until p hits index |
| while ($self->p < $index) { |
| $self->consume(); |
| } |
| return; |
| } |
| |
| sub substring { |
| my ($self, $start, $stop) = @_; |
| |
| return substr $self->input, $start, $stop - $start + 1; |
| } |
| |
| sub get_source_name { |
| my ($self) = @_; |
| return $self->name; |
| } |
| |
| no Moose; |
| __PACKAGE__->meta->make_immutable(); |
| 1; |