Home | History | Annotate | Download | only in Runtime 
      1 package ANTLR::Runtime::ANTLRStringStream;
      2 
      3 use Carp;
      4 use Readonly;
      5 
      6 use ANTLR::Runtime::CharStreamState;
      7 
      8 use Moose;
      9 
     10 with 'ANTLR::Runtime::IntStream', 'ANTLR::Runtime::CharStream';
     11 
     12 has 'input' => (
     13     is  => 'ro',
     14     isa => 'Str',
     15     required => 1,
     16 );
     17 
     18 has 'p' => (
     19     is  => 'rw',
     20     isa => 'Int',
     21     default => 0,
     22 );
     23 
     24 has 'line' => (
     25     is  => 'rw',
     26     isa => 'Int',
     27     default => 1,
     28 );
     29 
     30 has 'char_position_in_line' => (
     31     is  => 'rw',
     32     isa => 'Int',
     33     default => 0,
     34 );
     35 
     36 has 'mark_depth' => (
     37     is  => 'rw',
     38     isa => 'Int',
     39     default => 0,
     40 );
     41 
     42 has 'markers' => (
     43     is  => 'rw',
     44     isa => 'ArrayRef[Maybe[ANTLR::Runtime::CharStreamState]]',
     45     default => sub { [ undef ] },
     46 );
     47 
     48 has 'last_marker' => (
     49     is  => 'rw',
     50     isa => 'Int',
     51     default => 0,
     52 );
     53 
     54 has 'name' => (
     55     is  => 'rw',
     56     isa => 'Str',
     57     default => q{},
     58 );
     59 
     60 sub get_line {
     61     my ($self) = @_;
     62     return $self->line;
     63 }
     64 
     65 sub set_line {
     66     my ($self, $value) = @_;
     67     $self->line($value);
     68     return;
     69 }
     70 
     71 sub get_char_position_in_line {
     72     my ($self) = @_;
     73     return $self->char_position_in_line;
     74 }
     75 
     76 sub set_char_position_in_line {
     77     my ($self, $value) = @_;
     78     $self->char_position_in_line($value);
     79     return;
     80 }
     81 
     82 sub reset {
     83     my ($self) = @_;
     84 
     85     $self->p(0);
     86     $self->line(1);
     87     $self->char_position_in_line(0);
     88     $self->mark_depth(0);
     89     return;
     90 }
     91 
     92 sub consume {
     93     my ($self) = @_;
     94 
     95     if ($self->p < length $self->input) {
     96         $self->char_position_in_line($self->char_position_in_line + 1);
     97         if (substr($self->input, $self->p, 1) eq "\n") {
     98             $self->line($self->line + 1);
     99             $self->char_position_in_line(0);
    100         }
    101         $self->p($self->p + 1);
    102     }
    103     return;
    104 }
    105 
    106 sub LA {
    107     my ($self, $i) = @_;
    108 
    109     if ($i == 0) {
    110         return undef;
    111     }
    112 
    113     if ($i < 0) {
    114         ++$i; # e.g., translate LA(-1) to use offset i=0; then input[p+0-1]
    115         if ($self->p + $i - 1 < 0) {
    116             return $self->EOF;
    117         }
    118     }
    119 
    120     if ($self->p + $i - 1 >= length $self->input) {
    121         return $self->EOF;
    122     }
    123 
    124     return substr $self->input, $self->p + $i - 1, 1;
    125 }
    126 
    127 sub LT {
    128     my ($self, $i) = @_;
    129 
    130     return $self->LA($i);
    131 }
    132 
    133 sub index {
    134     my ($self) = @_;
    135 
    136     return $self->p;
    137 }
    138 
    139 sub size {
    140     my ($self) = @_;
    141 
    142     return length $self->input;
    143 }
    144 
    145 sub mark {
    146     my ($self) = @_;
    147 
    148     $self->mark_depth($self->mark_depth + 1);
    149     my $state;
    150     if ($self->mark_depth >= @{$self->markers}) {
    151         $state = ANTLR::Runtime::CharStreamState->new();
    152         push @{$self->markers}, $state;
    153     } else {
    154         $state = $self->markers->[$self->mark_depth];
    155     }
    156 
    157     $state->set_p($self->p);
    158     $state->set_line($self->line);
    159     $state->set_char_position_in_line($self->char_position_in_line);
    160     $self->last_marker($self->mark_depth);
    161 
    162     return $self->mark_depth;
    163 }
    164 
    165 sub rewind {
    166     my $self = shift;
    167     my $m;
    168     if (@_ == 0) {
    169         $m = $self->last_marker;
    170     } else {
    171         $m = shift;
    172     }
    173 
    174     my $state = $self->markers->[$m];
    175     # restore stream state
    176     $self->seek($state->get_p);
    177     $self->line($state->get_line);
    178     $self->char_position_in_line($state->get_char_position_in_line);
    179     $self->release($m);
    180     return;
    181 }
    182 
    183 sub release {
    184     my ($self, $marker) = @_;
    185 
    186     # unwind any other markers made after m and release m
    187     $self->mark_depth($marker);
    188     # release this marker
    189     $self->mark_depth($self->mark_depth - 1);
    190     return;
    191 }
    192 
    193 # consume() ahead unit p == index; can't just set p = index as we must update
    194 # line and char_position_in_line
    195 sub seek {
    196     my ($self, $index) = @_;
    197 
    198     if ($index <= $self->p) {
    199         # just jump; don't update stream state (line, ...)
    200         $self->p($index);
    201         return;
    202     }
    203 
    204     # seek forward, consume until p hits index
    205     while ($self->p < $index) {
    206         $self->consume();
    207     }
    208     return;
    209 }
    210 
    211 sub substring {
    212     my ($self, $start, $stop) = @_;
    213 
    214     return substr $self->input, $start, $stop - $start + 1;
    215 }
    216 
    217 sub get_source_name {
    218     my ($self) = @_;
    219     return $self->name;
    220 }
    221 
    222 no Moose;
    223 __PACKAGE__->meta->make_immutable();
    224 1;
    225