File Coverage

blib/lib/MarpaX/Languages/ECMAScript/AST/Grammar/Base.pm
Criterion Covered Total %
statement 59 175 33.7
branch 3 44 6.8
condition 0 28 0.0
subroutine 19 27 70.3
pod 17 17 100.0
total 98 291 33.6


line stmt bran cond sub pod time code
1 1     1   599 use strict;
  1         2  
  1         30  
2 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         56  
3              
4             package MarpaX::Languages::ECMAScript::AST::Grammar::Base;
5 1     1   611 use MarpaX::Languages::ECMAScript::AST::Util qw/:all/;
  1         4  
  1         252  
6 1     1   17 use MarpaX::Languages::ECMAScript::AST::Impl qw//;
  1         2  
  1         21  
7 1     1   5 use Log::Any qw/$log/;
  1         2  
  1         9  
8 1     1   125 use constant SEARCH_KEYWORD_IN_GRAMMAR => '# DO NOT REMOVE NOR MODIFY THIS LINE';
  1         2  
  1         73  
9 1     1   7 use MarpaX::Languages::ECMAScript::AST::Exceptions qw/:all/;
  1         3  
  1         2608  
10              
11             # ABSTRACT: ECMAScript, grammars base package
12              
13             our $VERSION = '0.018'; # VERSION
14              
15             #
16             # Note: because this module is usually subclasses, internal methods are called
17             # using _method($self, ...) instead of $self->_method(...)
18             #
19              
20              
21             sub new {
22 4     4 1 874 my ($class, $spec) = @_;
23              
24 4 50       17 InternalError(error => 'Missing ECMAScript specification') if (! defined($spec));
25              
26 4         30 my $self = {
27             _content => $class->make_content($spec),
28             _grammar_option => $class->make_grammar_option($spec),
29             _recce_option => $class->make_recce_option($spec),
30             };
31              
32 4         16 bless($self, $class);
33              
34 4         14 return $self;
35             }
36              
37              
38             sub content {
39 3     3 1 3 my ($self) = @_;
40 3         20 return $self->{_content};
41             }
42              
43              
44             sub make_content {
45 8     8 1 14 my ($class, $spec) = @_;
46              
47 8         34 my $content = $class->make_grammar_content;
48              
49             #
50             # Too painful to write MarpaX::Languages::ECMAScript::AST::Grammar::${spec}::CharacterClasses::IsSomething
51             # so I change it on-the-fly here
52             #
53 8 50       21 if ($spec eq 'ECMAScript-262-5') {
54 0         0 $spec = 'ECMAScript_262_5';
55             }
56 8         18 my $characterClass = "\\p{MarpaX::Languages::ECMAScript::AST::Grammar::${spec}::CharacterClasses::Is";
57 8         102 $content =~ s/\\p\{Is/$characterClass/g;
58              
59 8         92 return $content;
60             }
61              
62              
63             sub extract {
64 3     3 1 6 my ($self) = @_;
65 3         4 my $rc = '';
66              
67 3         19 my $content = $self->content;
68 3         8 my $index = index($content, SEARCH_KEYWORD_IN_GRAMMAR);
69 3 50       7 if ($index >= 0) {
70 3         8 $rc = substr($content, $index);
71 3         47 $rc =~ s/\baction[ \t]*=>[ \t]*\w+//g;
72 3         552 $rc =~ s/(__\w+)[ \t]*::=[ \t]*/$1 ~ /g;
73             }
74              
75 3         33 return $rc;
76             }
77              
78              
79             sub make_grammar_option {
80 4     4 1 7 my ($class, $spec) = @_;
81 4         60 return {bless_package => $class->make_bless_package,
82             source => \$class->make_content($spec, $class->make_grammar_content)};
83             }
84              
85              
86             sub make_grammar_content {
87 0     0 1 0 my ($class) = @_;
88 0         0 return undef;
89             }
90              
91              
92             sub make_bless_package {
93 4     4 1 8 my ($class) = @_;
94 4         18 return $class;
95             }
96              
97              
98             sub grammar_option {
99 1     1 1 3 my ($self) = @_;
100 1         20 return $self->{_grammar_option};
101             }
102              
103              
104             sub recce_option {
105 1     1 1 3 my ($self) = @_;
106 1         12 return $self->{_recce_option};
107             }
108              
109              
110             sub make_recce_option {
111 4     4 1 8 my ($class, $spec) = @_;
112 4         30 return {ranking_method => $class->make_ranking_method,
113             semantics_package => $class->make_semantics_package,
114             too_many_earley_items => $class->make_too_many_earley_items};
115             }
116              
117              
118             sub make_ranking_method {
119 4     4 1 6 my ($class) = @_;
120 4         29 return 'high_rule_only';
121             }
122              
123              
124             sub make_semantics_package {
125 2     2 1 3 my ($class) = @_;
126 2         18 return join('::', __PACKAGE__, 'DefaultSemanticsPackage');
127             }
128              
129              
130             sub make_too_many_earley_items {
131 4     4 1 7 my ($class) = @_;
132 4         27 return 0;
133             }
134              
135              
136             sub _callback {
137 0     0     my ($self, $source, $pos, $max, $impl, $callbackp, $originalErrorString, @args) = @_;
138              
139 0           my $rc = $pos;
140              
141 0           eval {$rc = &$callbackp(@args, $source, $pos, $max, $impl)};
  0            
142 0 0         if ($@) {
143 0           my $callbackErrorString = $@;
144 0           my $line_columnp;
145 0           eval {$line_columnp = lineAndCol($impl)};
  0            
146 0           my $context = _context($self, $impl);
147             #
148             # Now we can destroy the recognizer
149             #
150 0           $impl->destroy_R;
151 0 0         if (! $@) {
152 0 0 0       if (defined($originalErrorString) && $originalErrorString) {
153 0           SyntaxError(error => sprintf("%s\n%s\n\n%s%s", $originalErrorString, $callbackErrorString, showLineAndCol(@{$line_columnp}, $source), $context));
  0            
154             } else {
155 0           SyntaxError(error => sprintf("%s\n\n%s%s", $callbackErrorString, showLineAndCol(@{$line_columnp}, $source), $context));
  0            
156             }
157             } else {
158 0 0 0       if (defined($originalErrorString) && $originalErrorString) {
159 0           SyntaxError(error => sprintf("%s\n%s\n%s", $originalErrorString, $callbackErrorString, $context));
160             } else {
161 0           SyntaxError(error => sprintf("%s\n%s", $callbackErrorString, $context));
162             }
163             }
164             }
165              
166 0           return $rc;
167             }
168              
169             sub parse {
170 0     0 1   my ($self, $source, $impl, $optionsp, $start, $length) = @_;
171              
172 0   0       $optionsp //= {};
173 0           my $callbackp = $optionsp->{callback};
174 0   0       my $callbackargsp = $optionsp->{callbackargs} // [];
175 0           my @callbackargs = @{$callbackargsp};
  0            
176 0           my $failurep = $optionsp->{failure};
177 0   0       my $failureargsp = $optionsp->{failureargs} // [];
178 0           my @failureargs = @{$failureargsp};
  0            
179 0           my $endp = $optionsp->{end};
180 0   0       my $endargsp = $optionsp->{endargs} // [];
181 0           my @endargs = @{$endargsp};
  0            
182              
183 0   0       $start //= 0;
184 0   0       $length //= -1;
185              
186 0           my $sourceMaxPos = length($source) - 1;
187 0 0         if ($start < 0) {
188 0           $start += $sourceMaxPos + 1;
189             }
190 0 0         my $max = ($length < 0) ? ($length + $sourceMaxPos + 1) : ($start + $length);
191              
192 0           my $pos = $start;
193 0           my $stop;
194             my $newpos;
195              
196             #
197             # Create a recognizer
198             #
199 0           $impl->make_R;
200             #
201             # Lexer can fail
202             #
203 0           eval {$newpos = $impl->read(\$source, $pos, $length)};
  0            
204 0 0         if ($@) {
205             #
206             # Failure callback
207             #
208 0 0         if (defined($failurep)) {
209 0           $pos = _callback($self, $source, $pos, $max, $impl, $failurep, $@, @failureargs);
210             } else {
211 0           my $line_columnp = lineAndCol($impl);
212 0           my $context = _context($self, $impl);
213 0           $impl->destroy_R;
214 0           SyntaxError(error => sprintf("%s\n\n%s%s", $@, showLineAndCol(@{$line_columnp}, $source), $context));
  0            
215             }
216             } else {
217 0           $pos = $newpos;
218             }
219 0           do {
220             #
221             # Events
222             #
223 0 0         if (defined($callbackp)) {
224 0           $pos = _callback($self, $source, $pos, $max, $impl, $callbackp, undef, @callbackargs);
225             }
226             #
227             # Lexer can fail
228             #
229 0           eval {$newpos = $impl->resume($pos)};
  0            
230 0 0         if ($@) {
231 0 0         if (defined($failurep)) {
232             #
233             # Failure callback
234             #
235 0           $pos = _callback($self, $source, $pos, $max, $impl, $failurep, $@, @failureargs);
236             } else {
237 0           my $line_columnp = lineAndCol($impl);
238 0           my $context = _context($self, $impl);
239 0           $impl->destroy_R;
240 0           SyntaxError(error => sprintf("%s\n\n%s%s", $@, showLineAndCol(@{$line_columnp}, $source), $context));
  0            
241             }
242             } else {
243 0           $pos = $newpos;
244             }
245             } while ($pos <= $max);
246              
247 0 0         if (defined($endp)) {
248             #
249             # End callback
250             #
251 0           _callback($self, $source, $pos, $max, $impl, $endp, undef, @endargs);
252             }
253              
254 0           return $self;
255             }
256              
257              
258             sub value {
259 0     0 1   my ($self, $impl, $optionsp) = @_;
260              
261 0   0       $optionsp //= {};
262 0           my $traverserp = $optionsp->{traverser};
263 0   0       my $traverserscratchpadp = $optionsp->{traverserscratchpad} // {};
264              
265 0 0         my $asf = defined($traverserp) ? Marpa::R2::ASF->new({slr => $impl->R}) : undef;
266 0   0       my $rc = (defined($asf) ? $asf->traverse($traverserscratchpadp, $traverserp) : $impl->value()) || do {
267             my $lastExpression = _show_last_expression($self, $impl);
268             $impl->destroy_R;
269             InternalError(error => sprintf('%s', $lastExpression))
270             };
271              
272 0 0         if (! defined($rc)) {
273 0           $impl->destroy_R;
274 0           InternalError(error => 'Undefined parse tree value');
275             }
276 0 0 0       if ((! defined($asf)) && defined(my $rc2 = $impl->value())) {
277 0           $impl->destroy_R;
278 0           InternalError(error => 'More than one parse tree value');
279             }
280 0           $impl->destroy_R;
281              
282 0           return ${$rc};
  0            
283             }
284              
285             # ----------------------------------------------------------------------------------------
286              
287             sub _context {
288 0     0     my ($self, $impl) = @_;
289              
290 0 0         my $context = $log->is_debug ?
291             sprintf("\n\nContext:\n\n%s", $impl->show_progress()) :
292             '';
293              
294 0           return $context;
295             }
296              
297              
298             # ----------------------------------------------------------------------------------------
299              
300             sub getLexeme {
301 0     0 1   my ($self, $lexemeHashp, $impl) = @_;
302              
303 0           my $rc = 0;
304             #
305             # Get paused lexeme
306             #
307 0           my $lexeme = $impl->pause_lexeme();
308 0 0         if (defined($lexeme)) {
309 0           $lexemeHashp->{name} = $lexeme;
310 0           ($lexemeHashp->{start}, $lexemeHashp->{length}) = $impl->pause_span();
311 0           ($lexemeHashp->{line}, $lexemeHashp->{column}) = $impl->line_column($lexemeHashp->{start});
312 0           $lexemeHashp->{value} = $impl->literal($lexemeHashp->{start}, $lexemeHashp->{length});
313 0           $rc = 1;
314             }
315              
316 0           return $rc;
317             }
318              
319             # ----------------------------------------------------------------------------------------
320              
321              
322             # ----------------------------------------------------------------------------------------
323              
324             sub getLastLexeme {
325 0     0 1   my ($self, $lexemeHashp, $impl) = @_;
326              
327 0           my $rc = 0;
328             #
329             # Get last lexeme span
330             #
331 0           my ($start, $length) = lastLexemeSpan($impl);
332 0 0         if (defined($start)) {
333 0           ($lexemeHashp->{start}, $lexemeHashp->{length}) = ($start, $length);
334 0           $lexemeHashp->{value} = $impl->literal($lexemeHashp->{start}, $lexemeHashp->{length});
335 0           $rc = 1;
336             }
337              
338 0           return $rc;
339             }
340              
341             # ----------------------------------------------------------------------------------------
342              
343             sub _show_last_expression {
344 0     0     my ($self, $impl) = @_;
345              
346 0           my ($start, $end) = $impl->last_completed_range('SourceElement');
347 0 0         return 'No source element was successfully parsed' if (! defined($start));
348 0           my $lastExpression = $impl->range_to_string($start, $end);
349 0           return "Last SourceElement successfully parsed was: $lastExpression";
350             }
351              
352              
353             1;
354              
355             __END__