ANTLRStringStream.pm revision 324c4644fee44b9898524c09511bd33c3f12e2df 
1package ANTLR::Runtime::ANTLRStringStream;
2
3use Carp;
4use Readonly;
5
6use ANTLR::Runtime::CharStreamState;
7
8use Moose;
9
10with 'ANTLR::Runtime::IntStream', 'ANTLR::Runtime::CharStream';
11
12has 'input' => (
13    is  => 'ro',
14    isa => 'Str',
15    required => 1,
16);
17
18has 'p' => (
19    is  => 'rw',
20    isa => 'Int',
21    default => 0,
22);
23
24has 'line' => (
25    is  => 'rw',
26    isa => 'Int',
27    default => 1,
28);
29
30has 'char_position_in_line' => (
31    is  => 'rw',
32    isa => 'Int',
33    default => 0,
34);
35
36has 'mark_depth' => (
37    is  => 'rw',
38    isa => 'Int',
39    default => 0,
40);
41
42has 'markers' => (
43    is  => 'rw',
44    isa => 'ArrayRef[Maybe[ANTLR::Runtime::CharStreamState]]',
45    default => sub { [ undef ] },
46);
47
48has 'last_marker' => (
49    is  => 'rw',
50    isa => 'Int',
51    default => 0,
52);
53
54has 'name' => (
55    is  => 'rw',
56    isa => 'Str',
57    default => q{},
58);
59
60sub get_line {
61    my ($self) = @_;
62    return $self->line;
63}
64
65sub set_line {
66    my ($self, $value) = @_;
67    $self->line($value);
68    return;
69}
70
71sub get_char_position_in_line {
72    my ($self) = @_;
73    return $self->char_position_in_line;
74}
75
76sub set_char_position_in_line {
77    my ($self, $value) = @_;
78    $self->char_position_in_line($value);
79    return;
80}
81
82sub 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
92sub 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
106sub 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
127sub LT {
128    my ($self, $i) = @_;
129
130    return $self->LA($i);
131}
132
133sub index {
134    my ($self) = @_;
135
136    return $self->p;
137}
138
139sub size {
140    my ($self) = @_;
141
142    return length $self->input;
143}
144
145sub 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
165sub 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
183sub 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
195sub 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
211sub substring {
212    my ($self, $start, $stop) = @_;
213
214    return substr $self->input, $start, $stop - $start + 1;
215}
216
217sub get_source_name {
218    my ($self) = @_;
219    return $self->name;
220}
221
222no Moose;
223__PACKAGE__->meta->make_immutable();
2241;
225