File Coverage

blib/lib/Marpa/R2/Grammar.pm
Criterion Covered Total %
statement 683 842 81.1
branch 260 416 62.5
condition 59 109 54.1
subroutine 51 56 91.0
pod 0 39 0.0
total 1053 1462 72.0


line stmt bran cond sub pod time code
1             # Copyright 2022 Jeffrey Kegler
2             # This file is part of Marpa::R2. Marpa::R2 is free software: you can
3             # redistribute it and/or modify it under the terms of the GNU Lesser
4             # General Public License as published by the Free Software Foundation,
5             # either version 3 of the License, or (at your option) any later version.
6             #
7             # Marpa::R2 is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10             # Lesser General Public License for more details.
11             #
12             # You should have received a copy of the GNU Lesser
13             # General Public License along with Marpa::R2. If not, see
14             # http://www.gnu.org/licenses/.
15              
16             package Marpa::R2::Grammar;
17              
18 135     135   2622 use 5.010001;
  135         509  
19              
20 135     135   827 use warnings;
  135         257  
  135         4513  
21              
22             # There's a problem with this perlcritic check
23             # as of 9 Aug 2010
24 135     135   759 no warnings qw(recursion qw);
  135         339  
  135         6077  
25              
26 135     135   863 use strict;
  135         257  
  135         4428  
27              
28 135     135   828 use vars qw($VERSION $STRING_VERSION);
  135         321  
  135         13219  
29             $VERSION = '13.001_000';
30             $STRING_VERSION = $VERSION;
31             ## no critic(BuiltinFunctions::ProhibitStringyEval)
32             $VERSION = eval $VERSION;
33             ## use critic
34              
35             package Marpa::R2::Internal::Grammar;
36              
37 135     135   1016 use English qw( -no_match_vars );
  135         329  
  135         1039  
38              
39 135     135   119150 use Marpa::R2::Thin::Trace;
  135         372  
  135         1318802  
40              
41             our %DEFAULT_SYMBOLS_RESERVED;
42             %DEFAULT_SYMBOLS_RESERVED = map { ($_, 1) } split //xms, '}]>)';
43              
44             sub Marpa::R2::uncaught_error {
45 0     0 0 0 my ($error) = @_;
46              
47             # This would be Carp::confess, but in the testing
48             # the stack trace includes the hoped for error
49             # message, which causes spurious success reports.
50 0         0 Carp::croak( "libmarpa reported an error which Marpa::R2 did not catch\n",
51             $error );
52             } ## end sub Marpa::R2::uncaught_error
53              
54             package Marpa::R2::Internal::Grammar;
55              
56             sub Marpa::R2::Grammar::new {
57 642     642 0 45591 my ( $class, @arg_hashes ) = @_;
58              
59 642         1535 my $grammar = [];
60 642         1542 bless $grammar, $class;
61              
62             # set the defaults and the default defaults
63 642         3339 $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] = *STDERR;
64              
65 642         2038 $grammar->[Marpa::R2::Internal::Grammar::TRACE_RULES] = 0;
66 642         1423 $grammar->[Marpa::R2::Internal::Grammar::WARNINGS] = 1;
67 642         1846 $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK] = {};
68 642         1475 $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK] = {};
69 642         1467 $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION] = 'fatal';
70              
71 642         1381 $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS] = [];
72 642         1377 $grammar->[Marpa::R2::Internal::Grammar::RULES] = [];
73 642         1356 $grammar->[Marpa::R2::Internal::Grammar::RULE_ID_BY_TAG] = {};
74              
75 642         25509 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C] =
76             Marpa::R2::Thin::G->new( { if => 1 } );
77 642         5213 $grammar->[Marpa::R2::Internal::Grammar::TRACER] =
78             Marpa::R2::Thin::Trace->new($grammar_c);
79              
80 642         2975 $grammar->set(@arg_hashes);
81              
82 636         2394 return $grammar;
83             } ## end sub Marpa::R2::Grammar::new
84              
85             sub Marpa::R2::Grammar::tracer {
86 1756     1756 0 3877 return $_[0]->[Marpa::R2::Internal::Grammar::TRACER];
87             }
88              
89             sub Marpa::R2::Grammar::thin {
90 1171     1171 0 1986 return $_[0]->[Marpa::R2::Internal::Grammar::C];
91             }
92              
93             sub Marpa::R2::Grammar::thin_symbol {
94 0     0 0 0 my ( $grammar, $symbol_name ) = @_;
95 0         0 return $grammar->[Marpa::R2::Internal::Grammar::TRACER]
96             ->symbol_by_name($symbol_name);
97             }
98              
99             sub Marpa::R2::Grammar::set {
100 665     665 0 3007 my ( $grammar, @arg_hashes ) = @_;
101              
102             # set trace_fh even if no tracing, because we may turn it on in this method
103 665         2272 my $trace_fh =
104             $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];
105 665         1434 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
106              
107 665         1894 for my $args (@arg_hashes) {
108              
109 675         1708 my $ref_type = ref $args;
110 675 50       2056 if ( not $ref_type ) {
111 0         0 Carp::croak(
112             'Marpa::R2::Grammar expects args as ref to HASH; arg was non-reference'
113             );
114             }
115 675 50       2308 if ( $ref_type ne 'HASH' ) {
116 0         0 Carp::croak(
117             "Marpa::R2::Grammar expects args as ref to HASH, got ref to $ref_type instead"
118             );
119             }
120              
121             state $grammar_options = {
122 675         1729 map { ( $_, 1 ) }
  2074         4697  
123             qw{ _internal_
124             action_object
125             actions
126             bless_package
127             infinite_action
128             default_action
129             default_empty_action
130             default_rank
131             inaccessible_ok
132             rules
133             source
134             start
135             symbols
136             terminals
137             trace_file_handle
138             unproductive_ok
139             warnings
140             }
141             };
142              
143 675 50       1580 if (my @bad_options =
144 2918         7671 grep { not exists $grammar_options->{$_} }
145 675         2412 keys %{$args}
146             )
147             {
148 0         0 Carp::croak( 'Unknown option(s) for Marpa::R2::Grammar: ',
149             join q{ }, @bad_options );
150             } ## end if ( my @bad_options = grep { not exists $grammar_options...})
151              
152             # First pass options: These affect processing of other
153             # options and are expected to take force for the other
154             # options, even if specified afterwards
155              
156 675 100       2988 if ( defined( my $value = $args->{'_internal_'} ) ) {
157 542         1238 $grammar->[Marpa::R2::Internal::Grammar::INTERNAL] = $value;
158             }
159              
160 675 100       2307 if ( defined( my $value = $args->{'trace_file_handle'} ) ) {
161 276         1108 $trace_fh =
162             $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] =
163             $value;
164             }
165              
166 675 50       2158 if ( defined( my $value = $args->{'default_rank'} ) ) {
167 0 0       0 Marpa::R2::exception(
168             'default_rank option not allowed after grammar is precomputed'
169             ) if $grammar_c->is_precomputed();
170 0         0 $grammar_c->default_rank_set($value);
171             } ## end if ( defined( my $value = $args->{'default_rank'} ) )
172              
173              
174             # Second pass options
175              
176 675 100       2089 if ( defined( my $value = $args->{'symbols'} ) ) {
177 544 50       3584 Marpa::R2::exception(
178             'symbols option not allowed after grammar is precomputed')
179             if $grammar_c->is_precomputed();
180 544 50       1855 Marpa::R2::exception('symbols value must be REF to HASH')
181             if ref $value ne 'HASH';
182 544         1031 for my $symbol ( sort keys %{$value} ) {
  544         9973  
183 18787         28030 my $properties = $value->{$symbol};
184 18787         31546 assign_user_symbol( $grammar, $symbol, $properties );
185             }
186             } ## end if ( defined( my $value = $args->{'symbols'} ) )
187              
188 675 100       3418 if ( defined( my $value = $args->{'terminals'} ) ) {
189 61 50       668 Marpa::R2::exception(
190             'terminals option not allowed after grammar is precomputed')
191             if $grammar_c->is_precomputed();
192 61 50       265 Marpa::R2::exception('terminals value must be REF to ARRAY')
193             if ref $value ne 'ARRAY';
194 61         136 for my $symbol ( @{$value} ) {
  61         180  
195 128         420 assign_user_symbol( $grammar, $symbol, { terminal => 1 } );
196             }
197             } ## end if ( defined( my $value = $args->{'terminals'} ) )
198              
199 675 100       2369 if ( defined( my $value = $args->{'start'} ) ) {
200 639 50       3480 Marpa::R2::exception(
201             'start option not allowed after grammar is precomputed')
202             if $grammar_c->is_precomputed();
203 639         1642 $grammar->[Marpa::R2::Internal::Grammar::START_NAME] = $value;
204             } ## end if ( defined( my $value = $args->{'start'} ) )
205              
206 675         1504 my $stuifzand_source;
207             my $deprecated_source;
208              
209 675 100       2163 if ( defined( my $value = $args->{'source'} ) ) {
210 3 50       60 Marpa::R2::exception(
211             'source option not allowed after grammar is precomputed')
212             if $grammar_c->is_precomputed();
213 3 50       15 Marpa::R2::exception(
214             q{"source" named argument must be string or ref to SCALAR}
215             ) if ref $value ne 'SCALAR';
216 3         43 $stuifzand_source = $value;
217             }
218              
219 675 100       2064 if ( defined( my $value = $args->{'rules'} ) ) {
220 639 50       2168 Marpa::R2::exception(
221             'rules option not allowed after grammar is precomputed')
222             if $grammar_c->is_precomputed();
223             DO_RULES: {
224             ## These hacks are for previous method of specifying Stuifzand
225             ## grammars. They are now deprecated and undocumented.
226             ## Eventually they may be eliminated.
227 639 50 100     1233 if ( ref $value eq 'ARRAY'
  639   66     2540  
228 638         3087 and scalar @{$value} == 1
229             and not ref $value->[0] )
230             {
231 0         0 $value = $value->[0];
232             } ## end if ( ref $value eq 'ARRAY' and scalar @{$value} == 1...)
233 639 100       2098 if ( not ref $value ) {
234 1         3 $deprecated_source = \$value;
235             }
236 639 50 66     2118 if (defined $deprecated_source and defined $stuifzand_source) {
237 0         0 Marpa::R2::exception(
238             qq{Attempt to specify BNF via both 'rules' and 'source' named arguments\n},
239             q{ You must use one or the other},
240             )
241             }
242 639 100       1704 if (defined $deprecated_source) {
243 1         2 $stuifzand_source = $deprecated_source;
244 1         4 last DO_RULES;
245             }
246             Marpa::R2::exception(
247 638 50       1850 q{"rules" named argument must be string or ref to ARRAY}
248             ) if ref $value ne 'ARRAY';
249 638   50     3383 $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] //=
250             'standard';
251 638 50       1954 Marpa::R2::exception(
252             qq{Attempt to use the standard interface with a grammar that is already using the BNF interface\n},
253             q{ Mixing the BNF and standard interface is not allowed}
254             )
255             if $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] ne
256             'standard';
257 638         1901 add_user_rules( $grammar, $value );
258             } ## end DO_RULES:
259             } ## end if ( defined( my $value = $args->{'rules'} ) )
260              
261 669 100       3636 if ( defined $stuifzand_source ) {
262 4   50     32 $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] //=
263             'stuifzand';
264 4 50       15 Marpa::R2::exception(
265             qq{Attempt to use the standard interface with a grammar that is already using the BNF interface\n},
266             q{ Mixing the BNF and standard interface is not allowed}
267             )
268             if $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] ne
269             'stuifzand';
270 4         20 my $parse_result =
271             Marpa::R2::Internal::Stuifzand::parse_rules(
272             $stuifzand_source );
273 4         27 for my $rule ( @{ $parse_result->{rules} } ) {
  4         28  
274 75         144 add_user_rule( $grammar, $rule );
275             }
276             } ## end if ( defined $stuifzand_source )
277              
278 669 100       2590 if ( exists $args->{'default_empty_action'} ) {
279 9         20 my $value = $args->{'default_empty_action'};
280 9         21 $grammar->[Marpa::R2::Internal::Grammar::DEFAULT_EMPTY_ACTION] =
281             $value;
282             }
283              
284 669 100       2366 if ( defined( my $value = $args->{'actions'} ) ) {
285 17         45 $grammar->[Marpa::R2::Internal::Grammar::ACTIONS] = $value;
286             }
287              
288 669 100       2187 if ( defined( my $value = $args->{'bless_package'} ) ) {
289 110         328 $grammar->[Marpa::R2::Internal::Grammar::BLESS_PACKAGE] = $value;
290             }
291              
292 669 100       2018 if ( defined( my $value = $args->{'action_object'} ) ) {
293 4         18 $grammar->[Marpa::R2::Internal::Grammar::ACTION_OBJECT] = $value;
294             }
295              
296 669 100       1981 if ( defined( my $value = $args->{'default_action'} ) ) {
297 57         147 $grammar->[Marpa::R2::Internal::Grammar::DEFAULT_ACTION] = $value;
298             }
299              
300 669 100       2029 if ( defined( my $value = $args->{'infinite_action'} ) ) {
301 9 50 33     151 if ( $value && $grammar_c->is_precomputed() ) {
302 0 0       0 say {$trace_fh}
  0         0  
303             '"infinite_action" option is useless after grammar is precomputed'
304             or Marpa::R2::exception("Could not print: $ERRNO");
305             }
306             state $allowed_values =
307 9         39 { map { ( $_, 1 ) } qw(warn quiet fatal) };
  15         70  
308             Marpa::R2::exception(
309             q{infinite_action must be 'warn', 'quiet' or 'fatal'})
310 9 50       45 if not exists $allowed_values->{$value};
311 9         29 $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION] =
312             $value;
313             } ## end if ( defined( my $value = $args->{'infinite_action'}...))
314              
315 669 100       2006 if ( defined( my $value = $args->{'warnings'} ) ) {
316 8 50 66     68 if ( $value && $grammar_c->is_precomputed() ) {
317 0 0       0 say {$trace_fh}
  0         0  
318             q{"warnings" option is useless after grammar is precomputed}
319             or Marpa::R2::exception("Could not print: $ERRNO");
320             }
321 8         22 $grammar->[Marpa::R2::Internal::Grammar::WARNINGS] = $value;
322             } ## end if ( defined( my $value = $args->{'warnings'} ) )
323              
324 669 50       1977 if ( defined( my $value = $args->{'inaccessible_ok'} ) ) {
325 0 0 0     0 if ( $value && $grammar_c->is_precomputed() ) {
326 0 0       0 say {$trace_fh}
  0         0  
327             q{"inaccessible_ok" option is useless after grammar is precomputed}
328             or Marpa::R2::exception("Could not print: $ERRNO");
329              
330             } ## end if ( $value && $grammar_c->is_precomputed() )
331             GIVEN_REF_VALUE: {
332 0         0 my $ref_value = ref $value;
  0         0  
333 0 0       0 if ( $ref_value eq q{} ) {
334 0   0     0 $value //= {};
335 0         0 last GIVEN_REF_VALUE;
336             }
337 0 0       0 if ( $ref_value eq 'ARRAY' ) {
338 0         0 $value = { map { ( $_, 1 ) } @{$value} };
  0         0  
  0         0  
339 0         0 last GIVEN_REF_VALUE;
340             }
341             Marpa::R2::exception(
342 0         0 'value of inaccessible_ok option must be boolean or an array ref'
343             );
344             } ## end GIVEN_REF_VALUE:
345 0         0 $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK] =
346             $value;
347             } ## end if ( defined( my $value = $args->{'inaccessible_ok'}...))
348              
349 669 50       2849 if ( defined( my $value = $args->{'unproductive_ok'} ) ) {
350 0 0 0     0 if ( $value && $grammar_c->is_precomputed() ) {
351 0 0       0 say {$trace_fh}
  0         0  
352             q{"unproductive_ok" option is useless after grammar is precomputed}
353             or Marpa::R2::exception("Could not print: $ERRNO");
354             }
355             GIVEN_REF_VALUE: {
356 0         0 my $ref_value = ref $value;
  0         0  
357 0 0       0 if ( $ref_value eq q{} ) {
358 0   0     0 $value //= {};
359 0         0 last GIVEN_REF_VALUE;
360             }
361 0 0       0 if ( $ref_value eq 'ARRAY' ) {
362 0         0 $value = { map { ( $_, 1 ) } @{$value} };
  0         0  
  0         0  
363 0         0 last GIVEN_REF_VALUE;
364             }
365             Marpa::R2::exception(
366 0         0 'value of unproductive_ok option must be boolean or an array ref'
367             );
368             } ## end GIVEN_REF_VALUE:
369 0         0 $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK] =
370             $value;
371             } ## end if ( defined( my $value = $args->{'unproductive_ok'}...))
372              
373             } ## end for my $args (@arg_hashes)
374              
375 659         1697 return 1;
376             } ## end sub Marpa::R2::Grammar::set
377              
378             sub Marpa::R2::Grammar::symbol_reserved_set {
379 0     0 0 0 my ( $grammar, $final_character, $boolean ) = @_;
380 0 0       0 if ( length $final_character != 1 ) {
381 0         0 Marpa::R2::exception( 'symbol_reserved_set(): "',
382             $final_character, '" is not a symbol' );
383             }
384 0 0       0 if ( $final_character eq ']' ) {
385 0 0       0 return if $boolean;
386 0         0 Marpa::R2::exception(
387             q{symbol_reserved_set(): Attempt to unreserve ']'; this is not allowed}
388             );
389             } ## end if ( $final_character eq ']' ) ([)
390 0 0       0 if ( not exists $DEFAULT_SYMBOLS_RESERVED{$final_character} ) {
391 0         0 Marpa::R2::exception(
392             qq{symbol_reserved_set(): "$final_character" is not a reservable symbol}
393             );
394             }
395             # Return a value to make perlcritic happy
396 0 0       0 return $DEFAULT_SYMBOLS_RESERVED{$final_character} = $boolean ? 1 : 0;
397             } ## end sub Marpa::R2::Grammar::symbol_reserved_set
398              
399             sub Marpa::R2::Grammar::precompute {
400 98     98 0 842 my $grammar = shift;
401              
402 98         264 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
403 98         232 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
404 98         326 my $trace_fh =
405             $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];
406              
407 98         209 my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
408 98 50       343 if ($problems) {
409 0         0 Marpa::R2::exception(
410             Marpa::R2::Grammar::show_problems($grammar),
411             "Second attempt to precompute grammar with fatal problems\n",
412             'Marpa::R2 cannot proceed'
413             );
414             } ## end if ($problems)
415              
416 98 50       510 return $grammar if $grammar_c->is_precomputed();
417              
418 98         443 set_start_symbol($grammar);
419              
420             # Catch errors in precomputation
421 97         213 my $precompute_error_code = $Marpa::R2::Error::NONE;
422 97         360 $grammar_c->throw_set(0);
423 97         23401 my $precompute_result = $grammar_c->precompute();
424 97         547 $grammar_c->throw_set(1);
425              
426 97 100       387 if ( $precompute_result < 0 ) {
427 12         97 ($precompute_error_code) = $grammar_c->error();
428 12 50       48 if ( not defined $precompute_error_code ) {
429 0         0 Marpa::R2::exception(
430             'libmarpa error, but no error code returned');
431             }
432              
433             # If already precomputed, just return success
434 12 50       41 return $grammar
435             if $precompute_error_code == $Marpa::R2::Error::PRECOMPUTED;
436              
437             # Cycles are not necessarily errors,
438             # and get special handling
439 12 100       37 $precompute_error_code = $Marpa::R2::Error::NONE
440             if $precompute_error_code == $Marpa::R2::Error::GRAMMAR_HAS_CYCLE;
441              
442             } ## end if ( $precompute_result < 0 )
443              
444 97 100       346 if ( $precompute_error_code != $Marpa::R2::Error::NONE ) {
445              
446             # Report the errors, then return failure
447              
448 4 50       11 if ( $precompute_error_code == $Marpa::R2::Error::NO_RULES ) {
449 0         0 Marpa::R2::exception(
450             'Attempted to precompute grammar with no rules');
451             }
452 4 100       8 if ( $precompute_error_code == $Marpa::R2::Error::NULLING_TERMINAL ) {
453 1         3 my @nulling_terminals = ();
454 1         4 my $event_count = $grammar_c->event_count();
455             EVENT:
456 1         10 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
457 1         6 my ( $event_type, $value ) = $grammar_c->event($event_ix);
458 1 50       5 if ( $event_type eq 'MARPA_EVENT_NULLING_TERMINAL' ) {
459 1         4 push @nulling_terminals, $grammar->symbol_name($value);
460             }
461             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
462             my @nulling_terminal_messages =
463 1         4 map {qq{Nulling symbol "$_" is also a terminal\n}}
  1         6  
464             @nulling_terminals;
465 1         6 Marpa::R2::exception( @nulling_terminal_messages,
466             'A terminal symbol cannot also be a nulling symbol' );
467             } ## end if ( $precompute_error_code == ...)
468 3 100       8 if ( $precompute_error_code == $Marpa::R2::Error::COUNTED_NULLABLE ) {
469 1         2 my @counted_nullables = ();
470 1         4 my $event_count = $grammar_c->event_count();
471             EVENT:
472 1         5 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
473 1         6 my ( $event_type, $value ) = $grammar_c->event($event_ix);
474 1 50       6 if ( $event_type eq 'MARPA_EVENT_COUNTED_NULLABLE' ) {
475 1         5 push @counted_nullables, $grammar->symbol_name($value);
476             }
477             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
478             my @counted_nullable_messages = map {
479 1         3 q{Nullable symbol "}
  1         7  
480             . $_
481             . qq{" is on RHS of counted rule\n}
482             } @counted_nullables;
483 1         5 Marpa::R2::exception( @counted_nullable_messages,
484             'Counted nullables confuse Marpa -- please rewrite the grammar'
485             );
486             } ## end if ( $precompute_error_code == ...)
487              
488 2 50       6 if ( $precompute_error_code == $Marpa::R2::Error::NO_START_SYMBOL ) {
489 0         0 Marpa::R2::exception('No start symbol');
490             }
491 2 100       7 if ( $precompute_error_code == $Marpa::R2::Error::START_NOT_LHS ) {
492 1         2 my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
493 1         6 Marpa::R2::exception(
494             qq{Start symbol "$name" not on LHS of any rule});
495             }
496 1 50       5 if ( $precompute_error_code == $Marpa::R2::Error::UNPRODUCTIVE_START )
497             {
498 1         3 my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
499 1         6 Marpa::R2::exception(qq{Unproductive start symbol: "$name"});
500             }
501              
502 0         0 Marpa::R2::uncaught_error( scalar $grammar_c->error() );
503              
504             } ## end if ( $precompute_error_code != $Marpa::R2::Error::NONE)
505              
506             # Shadow all the new rules
507             {
508 93         187 my $highest_rule_id = $grammar_c->highest_rule_id();
  93         398  
509             RULE:
510 93         362 for ( my $rule_id = 0; $rule_id <= $highest_rule_id; $rule_id++ ) {
511 1638 50       3670 next RULE if defined $rules->[$rule_id];
512              
513             # The Marpa::R2 logic assumes no "gaps" in the rule numbering,
514             # which is currently the case for Libmarpa,
515             # but not guaranteed.
516 0         0 shadow_rule( $grammar, $rule_id );
517             } ## end RULE: for ( my $rule_id = 0; $rule_id <= $highest_rule_id; ...)
518             }
519              
520 93         285 my $infinite_action =
521             $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION];
522              
523             # Above I went through the error events
524             # Here I go through the events for situations where there was no
525             # hard error returned from libmarpa
526 93         235 my $loop_rule_count = 0;
527             {
528 93         193 my $event_count = $grammar_c->event_count();
  93         448  
529             EVENT:
530 93         391 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
531 8         43 my ( $event_type, $value ) = $grammar_c->event($event_ix);
532 8 50       27 if ( $event_type ne 'MARPA_EVENT_LOOP_RULES' ) {
533 0         0 Marpa::R2::exception(
534             qq{Unknown grammar precomputation event; type="$event_type"}
535             );
536             }
537 8         26 $loop_rule_count = $value;
538             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
539             }
540              
541 93 100 100     381 if ( $loop_rule_count and $infinite_action ne 'quiet' ) {
542             my @loop_rules =
543 6         14 grep { $grammar_c->rule_is_loop($_) } ( 0 .. $#{$rules} );
  35         80  
  6         20  
544 6         16 for my $rule_id (@loop_rules) {
545 16 50       25 print {$trace_fh}
  16         49  
546             'Cycle found involving rule: ',
547             $grammar->brief_rule($rule_id), "\n"
548             or Marpa::R2::exception("Could not print: $ERRNO");
549             } ## end for my $rule_id (@loop_rules)
550 6 50       42 Marpa::R2::exception('Cycles in grammar, fatal error')
551             if $infinite_action eq 'fatal';
552             } ## end if ( $loop_rule_count and $infinite_action ne 'quiet')
553              
554             # A bit hackish here: INACCESSIBLE_OK is not a HASH ref iff
555             # it is a Boolean TRUE indicating that all inaccessibles are OK.
556             # A Boolean FALSE will have been replaced with an empty hash.
557 93 100 66     706 if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
558             and ref(
559             my $ok = $grammar->[Marpa::R2::Internal::Grammar::INACCESSIBLE_OK]
560             ) eq 'HASH'
561             )
562             {
563             SYMBOL:
564 92         215 for my $symbol (
565 92         305 @{ Marpa::R2::Grammar::inaccessible_symbols($grammar) } )
566             {
567              
568             # Inaccessible internal symbols may be created
569             # from inaccessible use symbols -- ignore these.
570             # This assumes that Marpa's logic
571             # is correct and that
572             # it is not creating inaccessible symbols from
573             # accessible ones.
574 4 100       22 next SYMBOL if $symbol =~ /\]/xms;
575 2 50       7 next SYMBOL if $ok->{$symbol};
576 2 50       4 say {$trace_fh} "Inaccessible symbol: $symbol"
  2         15  
577             or Marpa::R2::exception("Could not print: $ERRNO");
578             } ## end SYMBOL: for my $symbol ( @{ ...})
579             } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])
580              
581             # A bit hackish here: UNPRODUCTIVE_OK is not a HASH ref iff
582             # it is a Boolean TRUE indicating that all inaccessibles are OK.
583             # A Boolean FALSE will have been replaced with an empty hash.
584 93 100 66     706 if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
585             and ref(
586             my $ok = $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK]
587             ) eq 'HASH'
588             )
589             {
590             SYMBOL:
591 92         207 for my $symbol (
592 92         268 @{ Marpa::R2::Grammar::unproductive_symbols($grammar) } )
593             {
594              
595             # Unproductive internal symbols may be created
596             # from unproductive use symbols -- ignore these.
597             # This assumes that Marpa's logic
598             # is correct and that
599             # it is not creating unproductive symbols from
600             # productive ones.
601 0 0       0 next SYMBOL if $symbol =~ /\]/xms;
602 0 0       0 next SYMBOL if $ok->{$symbol};
603 0 0       0 say {$trace_fh} "Unproductive symbol: $symbol"
  0         0  
604             or Marpa::R2::exception("Could not print: $ERRNO");
605             } ## end SYMBOL: for my $symbol ( @{ ...})
606             } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])
607              
608             # If we are using scannerless parsing, set that up
609 93 50       360 Marpa::R2::exception("Internal error; precompute called for SLIF grammar")
610             if $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES];
611              
612 93         360 return $grammar;
613              
614             } ## end sub Marpa::R2::Grammar::precompute
615              
616             # A custom precompute for SLIF grammars
617             sub Marpa::R2::Internal::Grammar::slif_precompute {
618 534     534   1212 my $grammar = shift;
619              
620 534         1097 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
621 534         1022 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
622 534         994 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
623 534         1330 my $trace_fh =
624             $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE];
625              
626 534         1011 my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
627 534 50       1443 if ($problems) {
628 0         0 Marpa::R2::exception(
629             Marpa::R2::Grammar::show_problems($grammar),
630             "Second attempt to precompute grammar with fatal problems\n",
631             'Marpa::R2 cannot proceed'
632             );
633             } ## end if ($problems)
634              
635 534 50       2134 return if $grammar_c->is_precomputed();
636 534 50       2694 if ($grammar_c->force_valued() < 0) {
637 0         0 Marpa::R2::uncaught_error( scalar $grammar_c->error() );
638             }
639              
640 534         2095 set_start_symbol($grammar);
641              
642             # Catch errors in precomputation
643 534         1060 my $precompute_error_code = $Marpa::R2::Error::NONE;
644 534         1674 $grammar_c->throw_set(0);
645 534         334019 my $precompute_result = $grammar_c->precompute();
646 534         3545 $grammar_c->throw_set(1);
647              
648 534 100       1810 if ( $precompute_result < 0 ) {
649 2         37 ($precompute_error_code) = $grammar_c->error();
650 2 50       9 if ( not defined $precompute_error_code ) {
651 0         0 Marpa::R2::exception(
652             'libmarpa error, but no error code returned');
653             }
654              
655             # If already precomputed, let higher level know
656 2 50       19 return $precompute_error_code
657             if $precompute_error_code == $Marpa::R2::Error::PRECOMPUTED;
658              
659             # Cycles are not necessarily errors,
660             # and get special handling
661 2 50       9 $precompute_error_code = $Marpa::R2::Error::NONE
662             if $precompute_error_code == $Marpa::R2::Error::GRAMMAR_HAS_CYCLE;
663              
664             } ## end if ( $precompute_result < 0 )
665              
666 534 100       1700 if ( $precompute_error_code != $Marpa::R2::Error::NONE ) {
667              
668             # Report the errors, then return failure
669              
670 2 50       9 if ( $precompute_error_code == $Marpa::R2::Error::NO_RULES ) {
671 0         0 Marpa::R2::exception(
672             'Attempted to precompute grammar with no rules');
673             }
674 2 50       10 if ( $precompute_error_code == $Marpa::R2::Error::NULLING_TERMINAL ) {
675 0         0 my @nulling_terminals = ();
676 0         0 my $event_count = $grammar_c->event_count();
677             EVENT:
678 0         0 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
679 0         0 my ( $event_type, $value ) = $grammar_c->event($event_ix);
680 0 0       0 if ( $event_type eq 'MARPA_EVENT_NULLING_TERMINAL' ) {
681 0         0 push @nulling_terminals, $grammar->symbol_name($value);
682             }
683             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
684             my @nulling_terminal_messages =
685 0         0 map {qq{Nulling symbol "$_" is also a terminal\n}}
  0         0  
686             @nulling_terminals;
687 0         0 Marpa::R2::exception( @nulling_terminal_messages,
688             'A terminal symbol cannot also be a nulling symbol' );
689             } ## end if ( $precompute_error_code == ...)
690 2 100       9 if ( $precompute_error_code == $Marpa::R2::Error::COUNTED_NULLABLE ) {
691 1         4 my @counted_nullables = ();
692 1         5 my $event_count = $grammar_c->event_count();
693             EVENT:
694 1         7 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
695 1         19 my ( $event_type, $value ) = $grammar_c->event($event_ix);
696 1 50       9 if ( $event_type eq 'MARPA_EVENT_COUNTED_NULLABLE' ) {
697 1         7 push @counted_nullables, $grammar->symbol_name($value);
698             }
699             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
700             my @counted_nullable_messages = map {
701 1         3 q{Nullable symbol "}
  1         6  
702             . $_
703             . qq{" is on RHS of counted rule\n}
704             } @counted_nullables;
705 1         11 Marpa::R2::exception( @counted_nullable_messages,
706             'Counted nullables confuse Marpa -- please rewrite the grammar'
707             );
708             } ## end if ( $precompute_error_code == ...)
709              
710 1 50       6 if ( $precompute_error_code == $Marpa::R2::Error::NO_START_SYMBOL ) {
711 0         0 Marpa::R2::exception('No start symbol');
712             }
713 1 50       5 if ( $precompute_error_code == $Marpa::R2::Error::START_NOT_LHS ) {
714 0         0 my $name = $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
715 0         0 Marpa::R2::exception(
716             qq{Start symbol "$name" not on LHS of any rule});
717             }
718              
719 1 50       8 return $precompute_error_code
720             if $precompute_error_code
721             == $Marpa::R2::Error::UNPRODUCTIVE_START;
722              
723 0         0 Marpa::R2::uncaught_error( scalar $grammar_c->error() );
724              
725             } ## end if ( $precompute_error_code != $Marpa::R2::Error::NONE)
726              
727             # Shadow all the new rules
728             {
729 532         987 my $highest_rule_id = $grammar_c->highest_rule_id();
  532         1833  
730             RULE:
731 532         1772 for ( my $rule_id = 0; $rule_id <= $highest_rule_id; $rule_id++ ) {
732 29967 50       62267 next RULE if defined $rules->[$rule_id];
733              
734             # The Marpa::R2 logic assumes no "gaps" in the rule numbering,
735             # which is currently the case for Libmarpa,
736             # but not guaranteed.
737 0         0 shadow_rule( $grammar, $rule_id );
738             } ## end RULE: for ( my $rule_id = 0; $rule_id <= $highest_rule_id; ...)
739             }
740              
741 532         1605 my $infinite_action =
742             $grammar->[Marpa::R2::Internal::Grammar::INFINITE_ACTION];
743              
744             # Above I went through the error events
745             # Here I go through the events for situations where there was no
746             # hard error returned from libmarpa
747 532         1215 my $loop_rule_count = 0;
748             {
749 532         873 my $event_count = $grammar_c->event_count();
  532         1955  
750             EVENT:
751 532         1712 for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
752 0         0 my ( $event_type, $value ) = $grammar_c->event($event_ix);
753 0 0       0 if ( $event_type ne 'MARPA_EVENT_LOOP_RULES' ) {
754 0         0 Marpa::R2::exception(
755             qq{Unknown grammar precomputation event; type="$event_type"}
756             );
757             }
758 0         0 $loop_rule_count = $value;
759             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
760             }
761              
762 532 50 33     1719 if ( $loop_rule_count and $infinite_action ne 'quiet' ) {
763             my @loop_rules =
764 0         0 grep { $grammar_c->rule_is_loop($_) } ( 0 .. $#{$rules} );
  0         0  
  0         0  
765 0         0 for my $rule_id (@loop_rules) {
766 0 0       0 print {$trace_fh}
  0         0  
767             'Cycle found involving rule: ',
768             $grammar->brief_rule($rule_id), "\n"
769             or Marpa::R2::exception("Could not print: $ERRNO");
770             } ## end for my $rule_id (@loop_rules)
771 0 0       0 Marpa::R2::exception('Cycles in grammar, fatal error')
772             if $infinite_action eq 'fatal';
773             } ## end if ( $loop_rule_count and $infinite_action ne 'quiet')
774              
775             my $default_if_inaccessible =
776             $grammar->[Marpa::R2::Internal::Grammar::INTERNAL]->{if_inaccessible}
777 532   50     1935 // 'warn';
778             SYMBOL:
779 532         1226 for my $symbol_id ( grep { !$grammar_c->symbol_is_accessible($_) }
  29553         61617  
780 532         2369 ( 0 .. $#{$symbols} ) )
781             {
782              
783 7         28 my $symbol = $symbols->[$symbol_id];
784 7         29 my $symbol_name = $grammar->symbol_name($symbol_id);
785              
786             # Inaccessible internal symbols may be created
787             # from inaccessible use symbols -- ignore these.
788             # This assumes that Marpa's logic
789             # is correct and that
790             # it is not creating inaccessible symbols from
791             # accessible ones.
792 7 50       30 next SYMBOL if $symbol_name =~ /\]/xms;
793 7   33     38 my $treatment =
794             $symbol->[Marpa::R2::Internal::Symbol::IF_INACCESSIBLE] //
795             $default_if_inaccessible;
796 7 100       29 next SYMBOL if $treatment eq 'ok';
797 2         8 my $message = "Inaccessible symbol: $symbol_name";
798 2 50       19 Marpa::R2::exception($message) if $treatment eq 'fatal';
799 0 0       0 say {$trace_fh} $message
  0         0  
800             or Marpa::R2::exception("Could not print: $ERRNO");
801             } ## end for my $symbol_id ( grep { !$grammar_c->...})
802              
803             # A bit hackish here: UNPRODUCTIVE_OK is not a HASH ref iff
804             # it is a Boolean TRUE indicating that all inaccessibles are OK.
805             # A Boolean FALSE will have been replaced with an empty hash.
806 530 50 33     4434 if ($grammar->[Marpa::R2::Internal::Grammar::WARNINGS]
807             and ref(
808             my $ok = $grammar->[Marpa::R2::Internal::Grammar::UNPRODUCTIVE_OK]
809             ) eq 'HASH'
810             )
811             {
812             SYMBOL:
813 530         982 for my $symbol (
814 530         1832 @{ Marpa::R2::Grammar::unproductive_symbols($grammar) } )
815             {
816              
817             # Unproductive internal symbols may be created
818             # from unproductive use symbols -- ignore these.
819             # This assumes that Marpa's logic
820             # is correct and that
821             # it is not creating unproductive symbols from
822             # productive ones.
823 0 0       0 next SYMBOL if $symbol =~ /\]/xms;
824 0 0       0 next SYMBOL if $ok->{$symbol};
825 0 0       0 say {$trace_fh} "Unproductive symbol: $symbol"
  0         0  
826             or Marpa::R2::exception("Could not print: $ERRNO");
827             } ## end SYMBOL: for my $symbol ( @{ ...})
828             } ## end if ( $grammar->[Marpa::R2::Internal::Grammar::WARNINGS...])
829              
830 530         1466 my $cc_hash = $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES];
831 530 50       1539 if ( defined $cc_hash ) {
832 0         0 my $class_table =
833             $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASS_TABLE] =
834             [];
835 0         0 for my $cc_symbol ( sort keys %{$cc_hash} ) {
  0         0  
836 0         0 my $cc_components = $cc_hash->{$cc_symbol};
837 0         0 push @{$class_table},
  0         0  
838             [ $grammar->thin_symbol($cc_symbol), $cc_components ];
839             }
840             } ## end if ( defined $cc_hash )
841              
842             # Save some memory
843 530         1089 $grammar->[Marpa::R2::Internal::Grammar::CHARACTER_CLASSES] = undef;
844              
845 530         2459 return ;
846              
847             } ## end sub Marpa::R2::Grammar::slif_precompute
848              
849             sub Marpa::R2::Grammar::show_problems {
850 1     1 0 793 my ($grammar) = @_;
851              
852 1         3 my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
853 1 50       5 if ($problems) {
854 0         0 my $problem_count = scalar @{$problems};
  0         0  
855             return
856             "Grammar has $problem_count problems:\n"
857 0         0 . ( join "\n", @{$problems} ) . "\n";
  0         0  
858             } ## end if ($problems)
859 1         4 return "Grammar has no problems\n";
860             } ## end sub Marpa::R2::Grammar::show_problems
861              
862             # Return DSL form of symbol
863             # Does no checking
864             sub Marpa::R2::Grammar::symbol_dsl_form {
865 59     59 0 100 my ( $grammar, $symbol_id ) = @_;
866 59         75 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
867 59         80 my $symbol = $symbols->[$symbol_id];
868 59         116 return $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM];
869             }
870              
871             # Return description of symbol
872             # Does no checking
873             sub Marpa::R2::Grammar::symbol_description {
874 59     59 0 119 my ( $grammar, $symbol_id ) = @_;
875 59         83 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
876 59         82 my $symbol = $symbols->[$symbol_id];
877 59         116 return $symbol->[Marpa::R2::Internal::Symbol::DESCRIPTION];
878             }
879              
880             # Return display form of symbol
881             # Does lots of checking and makes use of alternatives.
882             sub Marpa::R2::Grammar::symbol_in_display_form {
883 3902     3902 0 6399 my ( $grammar, $symbol_id ) = @_;
884 3902         5473 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
885 3902         4909 my $symbol = $symbols->[$symbol_id];
886 3902 50       6712 return "" if not defined $symbol;
887 3902         5290 my $text = $symbol->[Marpa::R2::Internal::Symbol::DISPLAY_FORM];
888 3902 100       7948 return $text if defined $text;
889 3082   33     6808 $text = $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM] //
890             $grammar->symbol_name($symbol_id);
891 3082 100       10412 return ($text =~ m/\s/xms) ? "<$text>" : $text;
892             }
893              
894             sub Marpa::R2::Grammar::show_symbol {
895 75     75 0 137 my ( $grammar, $symbol ) = @_;
896 75         124 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
897 75         111 my $text = q{};
898 75         132 my $symbol_id = $symbol->[Marpa::R2::Internal::Symbol::ID];
899              
900 75         161 my $name = $grammar->symbol_name($symbol_id);
901 75         186 $text .= "$symbol_id: $name";
902              
903 75         117 my @tag_list = ();
904 75 50       266 $grammar_c->symbol_is_productive($symbol_id)
905             or push @tag_list, 'unproductive';
906 75 50       207 $grammar_c->symbol_is_accessible($symbol_id)
907             or push @tag_list, 'inaccessible';
908 75 100       200 $grammar_c->symbol_is_nulling($symbol_id) and push @tag_list, 'nulling';
909 75 100       202 $grammar_c->symbol_is_terminal($symbol_id) and push @tag_list, 'terminal';
910              
911 75 100       188 $text .= join q{ }, q{,}, @tag_list if scalar @tag_list;
912 75         117 $text .= "\n";
913 75         328 return $text;
914              
915             } ## end sub Marpa::R2::Grammar::show_symbol
916              
917             sub Marpa::R2::Grammar::show_symbols {
918 11     11 0 995 my ($grammar) = @_;
919 11         28 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
920 11         29 my $text = q{};
921 11         38 for my $symbol_ref ( @{$symbols} ) {
  11         31  
922 75         165 $text .= $grammar->show_symbol($symbol_ref);
923             }
924 11         73 return $text;
925             } ## end sub Marpa::R2::Grammar::show_symbols
926              
927             sub Marpa::R2::Grammar::show_nulling_symbols {
928 2     2 0 11 my ($grammar) = @_;
929 2         7 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
930 2         5 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
931 2         8 return join q{ }, sort map { $grammar->symbol_name($_) }
932 2         7 grep { $grammar_c->symbol_is_nulling($_) } ( 0 .. $#{$symbols} );
  8         22  
  2         8  
933             } ## end sub Marpa::R2::Grammar::show_nulling_symbols
934              
935             sub Marpa::R2::Grammar::show_productive_symbols {
936 2     2 0 6 my ($grammar) = @_;
937 2         7 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
938 2         3 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
939 8         15 return join q{ }, sort map { $grammar->symbol_name($_) }
940 2         7 grep { $grammar_c->symbol_is_productive($_) } ( 0 .. $#{$symbols} );
  8         22  
  2         6  
941             } ## end sub Marpa::R2::Grammar::show_productive_symbols
942              
943             sub Marpa::R2::Grammar::show_accessible_symbols {
944 2     2 0 7 my ($grammar) = @_;
945 2         6 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
946 2         4 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
947 8         21 return join q{ }, sort map { $grammar->symbol_name($_) }
948 2         6 grep { $grammar_c->symbol_is_accessible($_) } ( 0 .. $#{$symbols} );
  8         24  
  2         7  
949             } ## end sub Marpa::R2::Grammar::show_accessible_symbols
950              
951             sub Marpa::R2::Grammar::inaccessible_symbols {
952 92     92 0 257 my ($grammar) = @_;
953 92         216 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
954 92         183 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
955             return [
956 4         16 sort map { $grammar->symbol_name($_) }
957 1407         3330 grep { !$grammar_c->symbol_is_accessible($_) }
958 92         239 ( 0 .. $#{$symbols} )
  92         307  
959             ];
960             } ## end sub Marpa::R2::Grammar::inaccessible_symbols
961              
962             sub Marpa::R2::Grammar::unproductive_symbols {
963 622     622 0 1629 my ($grammar) = @_;
964 622         1276 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
965 622         1188 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
966             return [
967 0         0 sort map { $grammar->symbol_name($_) }
968 30949         60521 grep { !$grammar_c->symbol_is_productive($_) }
969 622         1402 ( 0 .. $#{$symbols} )
  622         1695  
970             ];
971             } ## end sub Marpa::R2::Grammar::unproductive_symbols
972              
973             sub Marpa::R2::Grammar::start_symbol {
974 1     1 0 3 my ( $grammar ) = @_;
975 1         3 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
976 1         6 return $grammar_c->start_symbol();
977             }
978              
979             sub Marpa::R2::Grammar::rule_name {
980 659     659 0 1216 my ( $grammar, $rule_id ) = @_;
981 659         1113 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
982 659         939 my $rule = $rules->[$rule_id];
983 659 50       1307 return "Non-existent rule $rule_id" if not defined $rule;
984 659         1100 my $name = $rule->[Marpa::R2::Internal::Rule::NAME];
985 659 100       2119 return $name if defined $name;
986 1         2 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
987 1         5 my ( $lhs_id ) = $tracer->rule_expand($rule_id);
988 1         4 return $grammar->symbol_name($lhs_id);
989             } ## end sub Marpa::R2::Grammar::rule_name
990              
991             # Undocumented -- assumes it is called internally,
992             # by the SLIF
993             sub Marpa::R2::Grammar::tag {
994 20627     20627 0 29701 my ( $grammar, $rule_id ) = @_;
995 20627         27153 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
996 20627         25745 my $rule = $rules->[$rule_id];
997 20627         40291 return $rule->[Marpa::R2::Internal::Rule::SLIF_TAG];
998             } ## end sub Marpa::R2::Grammar::rule_name
999              
1000             sub Marpa::R2::Grammar::brief_rule {
1001 131     131 0 278 my ( $grammar, $rule_id ) = @_;
1002 131         208 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1003 131         303 my ( $lhs, @rhs ) = $grammar->rule($rule_id);
1004 131         438 my $minimum = $grammar_c->sequence_min($rule_id);
1005 131 100       321 my $quantifier = defined $minimum ? $minimum <= 0 ? q{*} : q{+} : q{};
    100          
1006 131         859 return ( join q{ }, "$rule_id:", $lhs, '->', @rhs ) . $quantifier;
1007             } ## end sub Marpa::R2::Grammar::brief_rule
1008              
1009             sub Marpa::R2::Grammar::show_rule {
1010 87     87 0 179 my ( $grammar, $rule ) = @_;
1011              
1012 87         158 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1013 87         141 my $rule_id = $rule->[Marpa::R2::Internal::Rule::ID];
1014 87         147 my @comment = ();
1015              
1016 87 100       303 $grammar_c->rule_length($rule_id) == 0 and push @comment, 'empty';
1017 87 100       213 $grammar->rule_is_used($rule_id) or push @comment, '!used';
1018 87 50       664 $grammar_c->rule_is_productive($rule_id) or push @comment, 'unproductive';
1019 87 50       268 $grammar_c->rule_is_accessible($rule_id) or push @comment, 'inaccessible';
1020 87 100       242 $rule->[Marpa::R2::Internal::Rule::DISCARD_SEPARATION]
1021             and push @comment, 'discard_sep';
1022              
1023 87         188 my $text = $grammar->brief_rule($rule_id);
1024              
1025 87 100       235 if (@comment) {
1026 20         82 $text .= q{ } . ( join q{ }, q{/*}, @comment, q{*/} );
1027             }
1028              
1029 87         269 return $text .= "\n";
1030              
1031             } # sub show_rule
1032              
1033             sub Marpa::R2::Grammar::show_rules {
1034 16     16 0 2781 my ($grammar) = @_;
1035 16         51 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
1036 16         31 my $text;
1037              
1038 16         44 for my $rule ( @{$rules} ) {
  16         52  
1039 87         202 $text .= $grammar->show_rule($rule);
1040             }
1041 16         133 return $text;
1042             } ## end sub Marpa::R2::Grammar::show_rules
1043              
1044             # This logic deals with gaps in the rule numbering.
1045             # Currently there are none, but Libmarpa does not
1046             # guarantee this.
1047             sub Marpa::R2::Grammar::rule_ids {
1048 4942     4942 0 9042 my ($grammar) = @_;
1049 4942         7900 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1050 4942         25550 return 0 .. $grammar_c->highest_rule_id();
1051             } ## end sub Marpa::R2::Grammar::rule_ids
1052              
1053             # This logic deals with gaps in the symbol numbering.
1054             # Currently there are none, but Libmarpa does not
1055             # guarantee this.
1056             sub Marpa::R2::Grammar::symbol_ids {
1057 6     6 0 14 my ($grammar) = @_;
1058 6         12 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1059 6         83 return 0 .. $grammar_c->highest_symbol_id();
1060             } ## end sub Marpa::R2::Grammar::rule_ids
1061              
1062             # Returns empty array if not such rule
1063             sub Marpa::R2::Grammar::rule {
1064 49971     49971 0 739161 my ( $grammar, $rule_id ) = @_;
1065 49971         70787 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
1066 49971         65451 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1067 49971         68964 my @symbol_names = ();
1068              
1069 49971         122493 my @symbols = $tracer->rule_expand($rule_id);
1070 49971         92839 SYMBOL_ID: for my $symbol_id (@symbols) {
1071             ## The name of the symbols, before the BNF rewrites
1072 124857   33     304455 my $name =
1073             $symbols->[$symbol_id]->[Marpa::R2::Internal::Symbol::LEGACY_NAME]
1074             // $grammar->symbol_name($symbol_id);
1075 124857         239559 push @symbol_names, $name;
1076             } ## end SYMBOL_ID: for my $symbol_id (@symbol_ids)
1077 49971         145399 return @symbol_names;
1078             } ## end sub Marpa::R2::Grammar::rule
1079              
1080             # Internal, for use with in coordinating thin and thick
1081             # interfaces. NOT DOCUMENTED.
1082             sub Marpa::R2::Grammar::_rule_mask {
1083 8250     8250   12314 my ( $grammar, $rule_id ) = @_;
1084 8250         10485 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
1085 8250         11548 my $rule = $rules->[$rule_id];
1086 8250         24342 return $rule->[Marpa::R2::Internal::Rule::MASK];
1087             } ## end sub Marpa::R2::Grammar::rule
1088              
1089             # Deprecated and for removal
1090             # Used in blog post, and part of
1091             # CPAN version 2.023_008 but
1092             # never documented in any CPAN version
1093             sub Marpa::R2::Grammar::bnf_rule {
1094 0     0 0 0 goto &Marpa::R2::Grammar::rule;
1095             } ## end sub Marpa::R2::Grammar::bnf_rule
1096              
1097             sub Marpa::R2::Grammar::show_dotted_rule {
1098 31     31 0 63 my ( $grammar, $rule_id, $dot_position ) = @_;
1099 31         55 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1100 31         71 my ( $lhs, @rhs ) = $grammar->rule($rule_id);
1101              
1102 31         89 my $minimum = $grammar_c->sequence_min($rule_id);
1103 31 100       81 if (defined $minimum) {
1104 1 50       4 my $quantifier = $minimum <= 0 ? q{*} : q{+} ;
1105 1         3 $rhs[0] .= $quantifier;
1106             }
1107 31 50       73 $dot_position = 0 if $dot_position < 0;
1108 31         79 splice @rhs, $dot_position, 0, q{.};
1109 31         119 return join q{ }, $lhs, q{->}, @rhs;
1110             } ## end sub Marpa::R2::Grammar::show_dotted_rule
1111              
1112             # Used by lexers to check that symbol is a terminal
1113             sub Marpa::R2::Grammar::check_terminal {
1114 1     1 0 2 my ( $grammar, $name ) = @_;
1115 1 50       4 return 0 if not defined $name;
1116 1         3 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1117 1         4 my $symbol_id =
1118             $grammar->[Marpa::R2::Internal::Grammar::TRACER]
1119             ->symbol_by_name($name);
1120 1 50       4 return 0 if not defined $symbol_id;
1121 1         3 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
1122 1         2 my $symbol = $symbols->[$symbol_id];
1123 1 50       7 return $grammar_c->symbol_is_terminal($symbol_id) ? 1 : 0;
1124             } ## end sub Marpa::R2::Grammar::check_terminal
1125              
1126             sub Marpa::R2::Grammar::symbol_name {
1127 172690     172690 0 268900 my ( $grammar, $id ) = @_;
1128 172690         320660 my $symbol_name =
1129             $grammar->[Marpa::R2::Internal::Grammar::TRACER]->symbol_name($id);
1130 172690 50       463850 return defined $symbol_name ? $symbol_name : '[SYMBOL#' . $id . ']';
1131             } ## end sub Marpa::R2::Grammar::symbol_name
1132              
1133             sub shadow_symbol {
1134 31031     31031   47509 my ( $grammar, $symbol_id ) = @_;
1135 31031         44251 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
1136 31031         59322 my $symbol = $symbols->[$symbol_id] = [];
1137 31031         51333 $symbol->[Marpa::R2::Internal::Symbol::ID] = $symbol_id;
1138 31031         49718 return $symbol;
1139             } ## end sub shadow_symbol
1140              
1141             # Create the structure which "shadows" the libmarpa rule
1142             sub shadow_rule {
1143 31655     31655   51225 my ( $grammar, $rule_id ) = @_;
1144 31655         45854 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
1145 31655         68407 my $new_rule = $rules->[$rule_id] = [];
1146 31655         52672 $new_rule->[Marpa::R2::Internal::Rule::ID] = $rule_id;
1147 31655         54559 return $new_rule;
1148             } ## end sub shadow_rule
1149              
1150             sub assign_symbol {
1151 118285     118285   197131 my ( $grammar, $name, $options ) = @_;
1152              
1153 118285         158864 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1154 118285         150050 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1155 118285         241075 my $symbol_id = $tracer->symbol_by_name($name);
1156 118285 100       221755 if ( defined $symbol_id ) {
1157 87254         116924 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
1158 87254         195191 return $symbols->[$symbol_id];
1159             }
1160 31031         60188 $symbol_id = $tracer->symbol_new($name);
1161 31031         56406 my $symbol = shadow_symbol( $grammar, $symbol_id );
1162              
1163 31031         42502 PROPERTY: for my $property ( sort keys %{$options} ) {
  31031         105566  
1164 55774 50       100487 if ( $property eq 'semantics' ) {
1165 0         0 my $value = $options->{$property};
1166 0         0 $symbol->[Marpa::R2::Internal::Symbol::LEXEME_SEMANTICS] = $value;
1167 0         0 next PROPERTY;
1168             }
1169 55774 50       88261 if ( $property eq 'bless' ) {
1170 0         0 my $value = $options->{$property};
1171 0         0 $symbol->[Marpa::R2::Internal::Symbol::BLESSING] = $value;
1172 0         0 next PROPERTY;
1173             }
1174 55774 100       87984 if ( $property eq 'terminal' ) {
1175 103         192 my $value = $options->{$property};
1176 103         372 $grammar_c->symbol_is_terminal_set( $symbol_id, $value );
1177 103         254 next PROPERTY;
1178             }
1179 55671 50       87102 if ( $property eq 'rank' ) {
1180 0         0 my $value = $options->{$property};
1181 0 0 0     0 Marpa::R2::exception(qq{Symbol "$name": rank must be an integer})
1182             if not Scalar::Util::looks_like_number($value)
1183             or int($value) != $value;
1184 0         0 $grammar_c->symbol_rank_set($symbol_id) = $value;
1185 0         0 next PROPERTY;
1186             } ## end if ( $property eq 'rank' )
1187 55671 100       88428 if ( $property eq 'description' ) {
1188 18780         30271 my $value = $options->{$property};
1189 18780         36548 $symbol->[Marpa::R2::Internal::Symbol::DESCRIPTION] = $value;
1190 18780         31794 next PROPERTY;
1191             }
1192 36891 100       61457 if ( $property eq 'dsl_form' ) {
1193 18051         27503 my $value = $options->{$property};
1194 18051         28129 $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM] = $value;
1195 18051         28187 next PROPERTY;
1196             }
1197 18840 100       30999 if ( $property eq 'legacy_name' ) {
1198 60         101 my $value = $options->{$property};
1199 60         105 $symbol->[Marpa::R2::Internal::Symbol::LEGACY_NAME] = $value;
1200 60         117 next PROPERTY;
1201             }
1202 18780 50       31383 if ( $property eq 'display_form' ) {
1203 18780         27828 my $value = $options->{$property};
1204 18780         30018 $symbol->[Marpa::R2::Internal::Symbol::DISPLAY_FORM] = $value;
1205 18780         28571 next PROPERTY;
1206             }
1207 0 0       0 if ( $property eq 'if_inaccessible' ) {
1208 0         0 my $value = $options->{$property};
1209 0         0 $symbol->[Marpa::R2::Internal::Symbol::IF_INACCESSIBLE] = $value;
1210 0         0 next PROPERTY;
1211             }
1212 0         0 Marpa::R2::exception(qq{Unknown symbol property "$property"});
1213             } ## end PROPERTY: for my $property ( keys %{$options} )
1214              
1215 31031         72298 return $symbol;
1216              
1217             } ## end sub assign_symbol
1218              
1219             sub assign_user_symbol {
1220 23908     23908   32635 my $grammar = shift;
1221 23908         31186 my $name = shift;
1222 23908         30165 my $options = shift;
1223 23908         32965 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1224              
1225 23908 50       45163 if ( my $type = ref $name ) {
1226 0         0 Marpa::R2::exception(
1227             "Symbol name was ref to $type; it must be a scalar string");
1228             }
1229 23908 100       42396 if ( not $grammar->[Marpa::R2::Internal::Grammar::INTERNAL] ) {
1230 5128         8136 my $final_symbol = substr $name, -1;
1231 5128 50       9843 if ( $DEFAULT_SYMBOLS_RESERVED{$final_symbol} ) {
1232 0         0 Marpa::R2::exception(
1233             qq{Symbol name $name ends in "$final_symbol": that's not allowed}
1234             );
1235             }
1236             } ## end if ( not $grammar->[Marpa::R2::Internal::Grammar::INTERNAL...])
1237 23908         39175 my $symbol = assign_symbol( $grammar, $name, $options );
1238              
1239 23908         44642 return $symbol;
1240              
1241             } ## end sub assign_user_symbol
1242              
1243             # add one or more rules
1244             sub add_user_rules {
1245 638     638   1679 my ( $grammar, $rules ) = @_;
1246              
1247 638         1416 my @hash_rules = ();
1248 638         1205 RULE: for my $rule ( @{$rules} ) {
  638         1724  
1249              
1250             # Translate other rule formats into hash rules
1251 31601         42065 my $ref_rule = ref $rule;
1252 31601 100       50357 if ( $ref_rule eq 'HASH' ) {
1253 31382         42777 push @hash_rules, $rule;
1254 31382         43857 next RULE;
1255             }
1256 219 50       450 if ( $ref_rule eq 'ARRAY' ) {
1257 219         297 my $arg_count = @{$rule};
  219         357  
1258              
1259 219 50 33     817 if ( $arg_count > 4 or $arg_count < 1 ) {
1260             Marpa::R2::exception(
1261             "Rule has $arg_count arguments: "
1262             . join( ', ',
1263 0 0       0 map { defined $_ ? $_ : 'undef' } @{$rule} )
  0         0  
  0         0  
1264             . "\n"
1265             . 'Rule must have from 1 to 4 arguments'
1266             );
1267             } ## end if ( $arg_count > 4 or $arg_count < 1 )
1268 219         320 my ( $lhs, $rhs, $action ) = @{$rule};
  219         421  
1269 219         603 push @hash_rules,
1270             {
1271             lhs => $lhs,
1272             rhs => $rhs,
1273             action => $action,
1274             };
1275 219         474 next RULE;
1276             } ## end if ( $ref_rule eq 'ARRAY' )
1277             Marpa::R2::exception(
1278 0         0 'Invalid rule: ',
1279             Data::Dumper->new( [$rule], ['Invalid_Rule'] )->Indent(2)
1280             ->Terse(1)->Maxdepth(2)->Dump,
1281             'Rule must be ref to HASH or ARRAY'
1282             );
1283              
1284             } # RULE
1285              
1286 638         2273 for my $hash_rule (@hash_rules) {
1287 31586         56306 add_user_rule( $grammar, $hash_rule );
1288             }
1289              
1290 632         3265 return;
1291              
1292             } ## end sub add_user_rules
1293              
1294             sub add_user_rule {
1295 31661     31661   52487 my ( $grammar, $options ) = @_;
1296              
1297 31661 50 33     93499 Marpa::R2::exception('Missing argument to add_user_rule')
1298             if not defined $grammar
1299             or not defined $options;
1300              
1301 31661         46702 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1302 31661         42060 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1303 31661         42241 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
1304 31661         65793 my $default_rank = $grammar_c->default_rank();
1305              
1306 31661         161057 my ( $lhs_name, $rhs_names, $action, $blessing );
1307 31661         0 my ( $min, $separator_name );
1308 31661         0 my $rank;
1309 31661         0 my $null_ranking;
1310 31661         0 my $rule_name;
1311 31661         0 my $slif_tag;
1312 31661         0 my $mask;
1313 31661         42406 my $proper_separation = 0;
1314 31661         39986 my $keep_separation = 0;
1315 31661         42910 my $description;
1316              
1317 31661         40545 OPTION: for my $option ( keys %{$options} ) {
  31661         110425  
1318 140948         215600 my $value = $options->{$option};
1319 140948 100       235427 if ( $option eq 'name' ) { $rule_name = $value; next OPTION; }
  10222         13877  
  10222         16365  
1320 130726 100       209450 if ( $option eq 'tag' ) { $slif_tag = $value; next OPTION; }
  12463         17370  
  12463         19997  
1321 118263 100       191324 if ( $option eq 'rhs' ) { $rhs_names = $value; next OPTION }
  31657         41492  
  31657         50473  
1322 86606 100       140733 if ( $option eq 'lhs' ) { $lhs_name = $value; next OPTION }
  31661         42167  
  31661         50577  
1323 54945 100       88211 if ( $option eq 'action' ) { $action = $value; next OPTION }
  9840         13382  
  9840         15543  
1324 45105 100       74181 if ( $option eq 'bless' ) { $blessing = $value; next OPTION }
  8275         10890  
  8275         13310  
1325 36830 100       60777 if ( $option eq 'rank' ) { $rank = $value; next OPTION }
  64         111  
  64         145  
1326 36766 100       60724 if ( $option eq 'null_ranking' ) {
1327 4         11 $null_ranking = $value;
1328 4         8 next OPTION;
1329             }
1330 36762 100       60797 if ( $option eq 'min' ) { $min = $value; next OPTION }
  1735         2847  
  1735         3073  
1331 35027 100       58048 if ( $option eq 'separator' ) {
1332 328         715 $separator_name = $value;
1333 328         744 next OPTION;
1334             }
1335 34699 100       56183 if ( $option eq 'proper' ) {
1336 232         534 $proper_separation = $value;
1337 232         563 next OPTION;
1338             }
1339 34467 100       56718 if ( $option eq 'keep' ) { $keep_separation = $value; next OPTION }
  15         18  
  15         28  
1340 34452 100       57437 if ( $option eq 'mask' ) { $mask = $value; next OPTION }
  19423         25171  
  19423         31047  
1341 15029 50       26849 if ( $option eq 'description' ) { $description = $value; next OPTION }
  15029         20193  
  15029         24316  
1342 0         0 Marpa::R2::exception("Unknown user rule option: $option");
1343             } ## end OPTION: for my $option ( keys %{$options} )
1344              
1345 31661 50 66     77669 if ( defined $min and not Scalar::Util::looks_like_number($min) ) {
1346 0         0 Marpa::R2::exception(
1347             q{"min" must be undefined or a valid Perl number});
1348             }
1349 31661         52028 my $stuifzand_interface =
1350             $grammar->[Marpa::R2::Internal::Grammar::INTERFACE] eq 'stuifzand';
1351              
1352 31661   100     82173 my $grammar_is_internal = $stuifzand_interface
1353             || $grammar->[Marpa::R2::Internal::Grammar::INTERNAL];
1354              
1355 31661 100       68618 my $lhs =
1356             $grammar_is_internal
1357             ? assign_symbol( $grammar, $lhs_name )
1358             : assign_user_symbol( $grammar, $lhs_name );
1359 31661   100     60044 $rhs_names //= [];
1360              
1361 31661         46606 my @rule_problems = ();
1362              
1363 31661         52822 my $rhs_ref_type = ref $rhs_names;
1364 31661 50 33     96055 if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' ) {
1365 0 0       0 my $problem =
1366             "RHS is not ref to ARRAY\n"
1367             . ' Type of rhs is '
1368             . ( $rhs_ref_type ? $rhs_ref_type : 'not a ref' ) . "\n";
1369 0         0 my $d = Data::Dumper->new( [$rhs_names], ['rhs'] );
1370 0         0 $problem .= $d->Dump();
1371 0         0 push @rule_problems, $problem;
1372             } ## end if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' )
1373 31661 50       55170 if ( not defined $lhs_name ) {
1374 0         0 push @rule_problems, "Missing LHS\n";
1375             }
1376              
1377 31661 50 33     54269 if ( defined $rank
      66        
1378             and
1379             ( not Scalar::Util::looks_like_number($rank) or int($rank) != $rank )
1380             )
1381             {
1382 0         0 push @rule_problems, "Rank must be undefined or an integer\n";
1383             } ## end if ( defined $rank and ( not Scalar::Util::looks_like_number...))
1384 31661   66     97416 $rank //= $default_rank;
1385              
1386 31661   100     97873 $null_ranking //= 'low';
1387 31661 50 66     86993 if ( $null_ranking ne 'high' and $null_ranking ne 'low' ) {
1388 0         0 push @rule_problems,
1389             "Null Ranking must be undefined, 'high' or 'low'\n";
1390             }
1391              
1392 31661 50       59129 if ( scalar @rule_problems ) {
1393 0         0 my %dump_options = %{$options};
  0         0  
1394 0         0 delete $dump_options{grammar};
1395 0         0 my $msg = ( scalar @rule_problems )
1396             . " problem(s) in the following rule:\n";
1397 0         0 my $d = Data::Dumper->new( [ \%dump_options ], ['rule'] );
1398 0         0 $msg .= $d->Dump();
1399 0         0 for my $problem_number ( 0 .. $#rule_problems ) {
1400 0         0 $msg
1401             .= 'Problem '
1402             . ( $problem_number + 1 ) . q{: }
1403             . $rule_problems[$problem_number] . "\n";
1404             } ## end for my $problem_number ( 0 .. $#rule_problems )
1405 0         0 Marpa::R2::exception($msg);
1406             } ## end if ( scalar @rule_problems )
1407              
1408             my $rhs = [
1409             map {
1410 67381 100       128155 $grammar_is_internal
1411             ? assign_symbol( $grammar, $_ )
1412             : assign_user_symbol( $grammar, $_ );
1413 31661         45010 } @{$rhs_names}
  31661         65978  
1414             ];
1415              
1416             # Is this is an ordinary, non-counted rule?
1417 31661   100     51467 my $is_ordinary_rule = scalar @{$rhs_names} == 0 || !defined $min;
1418 31661 50 66     67662 if ( defined $separator_name and $is_ordinary_rule ) {
1419 0 0       0 if ( defined $separator_name ) {
1420 0         0 Marpa::R2::exception(
1421             'separator defined for rule without repetitions');
1422             }
1423             } ## end if ( defined $separator_name and $is_ordinary_rule )
1424              
1425 31661         41814 my @rhs_ids = map { $_->[Marpa::R2::Internal::Symbol::ID] } @{$rhs};
  67381         114992  
  31661         50304  
1426 31661         50198 my $lhs_id = $lhs->[Marpa::R2::Internal::Symbol::ID];
1427              
1428 31661         40762 my $base_rule_id;
1429 31661         42366 my $separator_id = -1;
1430              
1431 31661 100       51628 if ($is_ordinary_rule) {
1432              
1433             # Capture errors
1434 29926         79080 $grammar_c->throw_set(0);
1435 29926         110867 $base_rule_id = $grammar_c->rule_new( $lhs_id, \@rhs_ids );
1436 29926         58491 $grammar_c->throw_set(1);
1437              
1438             } ## end if ($is_ordinary_rule)
1439             else {
1440             Marpa::R2::exception('Only one rhs symbol allowed for counted rule')
1441 1735 50       2549 if scalar @{$rhs_names} != 1;
  1735         4222  
1442              
1443             # create the separator symbol, if we're using one
1444 1735 100       3715 if ( defined $separator_name ) {
1445 328 100       1251 my $separator =
1446             $grammar_is_internal
1447             ? assign_symbol( $grammar, $separator_name )
1448             : assign_user_symbol( $grammar, $separator_name );
1449 328         847 $separator_id = $separator->[Marpa::R2::Internal::Symbol::ID];
1450             } ## end if ( defined $separator_name )
1451              
1452 1735         5075 $grammar_c->throw_set(0);
1453              
1454             # The original rule for a sequence rule is
1455             # not actually used in parsing,
1456             # but some of the rewritten sequence rules are its
1457             # semantic equivalents.
1458              
1459 1735         11640 $base_rule_id = $grammar_c->sequence_new(
1460             $lhs_id,
1461             $rhs_ids[0],
1462             { separator => $separator_id,
1463             proper => $proper_separation,
1464             min => $min,
1465             }
1466             );
1467 1735         5591 $grammar_c->throw_set(1);
1468             } ## end else [ if ($is_ordinary_rule) ]
1469              
1470 31661 100 66     100639 if ( not defined $base_rule_id or $base_rule_id < 0 ) {
1471 6         24 my $rule_description = rule_describe( $lhs_name, $rhs_names );
1472 6         46 my ( $error_code, $error_string ) = $grammar_c->error();
1473 6   50     43 $error_code //= -1;
1474 6 100       25 my $problem_description =
1475             $error_code == $Marpa::R2::Error::DUPLICATE_RULE
1476             ? 'Duplicate rule'
1477             : $error_string;
1478 6         38 Marpa::R2::exception("$problem_description: $rule_description");
1479             } ## end if ( not defined $base_rule_id or $base_rule_id < 0 )
1480              
1481 31655         56866 my $base_rule = shadow_rule( $grammar, $base_rule_id );
1482              
1483 31655 100       58077 if ($is_ordinary_rule) {
1484              
1485             # Only internal grammars can set a custom mask
1486 29920 100 66     77378 if ( not defined $mask or not $grammar_is_internal ) {
1487 10500         25615 $mask = [ (1) x scalar @rhs_ids ];
1488             }
1489 29920         48940 $base_rule->[Marpa::R2::Internal::Rule::MASK] = $mask;
1490             } ## end if ($is_ordinary_rule)
1491              
1492 31655   100     76656 $base_rule->[Marpa::R2::Internal::Rule::DISCARD_SEPARATION] =
1493             $separator_id >= 0 && !$keep_separation;
1494              
1495 31655         65904 $base_rule->[Marpa::R2::Internal::Rule::ACTION_NAME] = $action;
1496 31655 100       103556 $grammar_c->rule_null_high_set( $base_rule_id,
1497             ( $null_ranking eq 'high' ? 1 : 0 ) );
1498 31655         77527 $grammar_c->rule_rank_set( $base_rule_id, $rank );
1499              
1500 31655 100       58775 if ( defined $rule_name ) {
1501 9781         16543 $base_rule->[Marpa::R2::Internal::Rule::NAME] = $rule_name;
1502             }
1503 31655 100       55139 if ( defined $slif_tag ) {
1504 12463         23222 $base_rule->[Marpa::R2::Internal::Rule::SLIF_TAG] = $slif_tag;
1505 12463         17783 my $rule_id_by_tag =
1506             $grammar->[Marpa::R2::Internal::Grammar::RULE_ID_BY_TAG];
1507 12463 50       24510 if ( $rule_id_by_tag->{$slif_tag} ) {
1508 0         0 Marpa::R2::exception(
1509             qq{Duplicate tag in SLIF rule, tag was "$slif_tag"});
1510             }
1511 12463         27337 $rule_id_by_tag->{$slif_tag} = $base_rule_id;
1512             } ## end if ( defined $slif_tag )
1513 31655 100       54037 if ( defined $blessing ) {
1514 8275         15813 $base_rule->[Marpa::R2::Internal::Rule::BLESSING] = $blessing;
1515             }
1516 31655 100       53669 if ( defined $description ) {
1517 15028         29521 $base_rule->[Marpa::R2::Internal::Rule::DESCRIPTION] = $description;
1518             }
1519              
1520 31655         90874 return;
1521              
1522             } ## end sub add_user_rule
1523              
1524             sub rule_describe {
1525 6     6   21 my ( $lhs_name, $rhs_names ) = @_;
1526             # wrap symbol names with whitespaces allowed by SLIF
1527 6 100       34 $lhs_name = "<$lhs_name>" if $lhs_name =~ / /;
1528 6 100       17 return "$lhs_name -> " . ( join q{ }, map { / / ? "<$_>" : $_ } @{$rhs_names} );
  6         40  
  6         15  
1529             } ## end sub rule_describe
1530              
1531             sub set_start_symbol {
1532 632     632   1266 my $grammar = shift;
1533              
1534 632         1443 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1535 632         1288 state $default_start_name = '[:start]';
1536 632         1229 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1537 632         1912 my $default_start_id = $tracer->symbol_by_name($default_start_name);
1538 632         1291 my $start_id;
1539             VALIDATE_START_NAME: {
1540 632         1177 my $named_arg_start_name =
  632         1424  
1541             $grammar->[Marpa::R2::Internal::Grammar::START_NAME];
1542 632 50 66     3348 if ( defined $named_arg_start_name and defined $start_id ) {
1543 0         0 Marpa::R2::exception(
1544             qq{Start symbol specified as '[:start]', but also with named argument\n},
1545             qq{ You must use one or the other\n}
1546             );
1547             } ## end if ( defined $named_arg_start_name and defined $start_id)
1548 632 100       1913 if ( defined $named_arg_start_name ) {
1549 629         1781 $start_id = $tracer->symbol_by_name($named_arg_start_name);
1550 629 50       2010 Marpa::R2::exception(
1551             qq{Start symbol "$named_arg_start_name" not in grammar})
1552             if not defined $start_id;
1553 629         1613 last VALIDATE_START_NAME;
1554             } ## end if ( defined $named_arg_start_name )
1555 3 100       11 if ( defined $default_start_id ) {
1556 2         6 $start_id = $default_start_id;
1557 2         5 $grammar->[Marpa::R2::Internal::Grammar::START_NAME] =
1558             $named_arg_start_name;
1559 2         6 last VALIDATE_START_NAME;
1560             } ## end if ( defined $default_start_id )
1561 1         4 Marpa::R2::exception(qq{No start symbol specified in grammar\n});
1562             } ## end VALIDATE_START_NAME:
1563              
1564 631 50       3286 if ( not defined $grammar_c->start_symbol_set($start_id) ) {
1565 0         0 Marpa::R2::uncaught_error( $grammar_c->error() );
1566             }
1567 631         1354 return 1;
1568             } ## end sub set_start_symbol
1569              
1570             sub Marpa::R2::Grammar::error {
1571 0     0 0 0 my ($grammar) = @_;
1572 0         0 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1573 0         0 return $grammar_c->error();
1574             }
1575              
1576             # INTERNAL OK AFTER HERE _marpa_
1577              
1578             sub Marpa::R2::Grammar::show_isy {
1579 37     37 0 66 my ( $grammar, $isy_id ) = @_;
1580 37         54 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1581 37         53 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1582 37         50 my $text = q{};
1583              
1584 37         75 my $name = $tracer->isy_name($isy_id);
1585 37         79 $text .= "$isy_id: $name";
1586              
1587 37         53 my @tag_list = ();
1588 37 100       97 $grammar_c->_marpa_g_nsy_is_nulling($isy_id)
1589             and push @tag_list, 'nulling';
1590              
1591 37 100       80 $text .= join q{ }, q{,}, @tag_list if scalar @tag_list;
1592 37         50 $text .= "\n";
1593              
1594 37         92 return $text;
1595              
1596             } ## end sub Marpa::R2::Grammar::show_isy
1597              
1598             sub Marpa::R2::Grammar::show_isys {
1599 3     3 0 9 my ($grammar) = @_;
1600 3         8 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1601 3         8 my $text = q{};
1602 3         21 for my $isy_id ( 0 .. $grammar_c->_marpa_g_nsy_count() - 1 ) {
1603 37         66 $text .= $grammar->show_isy($isy_id);
1604             }
1605 3         16 return $text;
1606             } ## end sub Marpa::R2::Grammar::show_isys
1607              
1608             sub Marpa::R2::Grammar::brief_irl {
1609 58     58 0 102 my ( $grammar, $irl_id ) = @_;
1610 58         88 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1611 58         80 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1612 58         135 my $lhs_id = $grammar_c->_marpa_g_irl_lhs($irl_id);
1613 58         179 my $text = $irl_id . ': ' . $tracer->isy_name($lhs_id) . ' ->';
1614 58 50       178 if ( my $rh_length = $grammar_c->_marpa_g_irl_length($irl_id) ) {
1615 58         96 my @rhs_ids = ();
1616 58         124 for my $ix ( 0 .. $rh_length - 1 ) {
1617 139         297 push @rhs_ids, $grammar_c->_marpa_g_irl_rhs( $irl_id, $ix );
1618             }
1619 58         105 $text .= q{ } . ( join q{ }, map { $tracer->isy_name($_) } @rhs_ids );
  139         353  
1620             } ## end if ( my $rh_length = $grammar_c->_marpa_g_irl_length...)
1621 58         204 return $text;
1622             } ## end sub Marpa::R2::Grammar::brief_irl
1623              
1624             sub Marpa::R2::Grammar::show_irls {
1625 3     3 0 13 my ($grammar) = @_;
1626 3         9 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1627 3         10 my $text = q{};
1628 3         43 for my $irl_id ( 0 .. $grammar_c->_marpa_g_irl_count() - 1 ) {
1629 56         112 $text .= $grammar->brief_irl($irl_id) . "\n";
1630             }
1631 3         23 return $text;
1632             } ## end sub Marpa::R2::Grammar::show_irls
1633              
1634             sub Marpa::R2::Grammar::rule_is_used {
1635 135     135 0 260 my ( $grammar, $rule_id ) = @_;
1636 135         217 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1637 135         676 return $grammar_c->_marpa_g_rule_is_used($rule_id);
1638             }
1639              
1640             sub Marpa::R2::Grammar::show_ahms {
1641 14     14 0 2014 my ( $grammar, $verbose ) = @_;
1642 14         86 return $grammar->[Marpa::R2::Internal::Grammar::TRACER]
1643             ->show_ahms($verbose);
1644             }
1645              
1646             1;
1647              
1648             # vim: expandtab shiftwidth=4: