File Coverage

blib/lib/Marpa/PP/Grammar.pm
Criterion Covered Total %
statement 1309 1474 88.8
branch 333 452 73.6
condition 72 109 66.0
subroutine 71 74 95.9
pod 8 26 30.7
total 1793 2135 83.9


line stmt bran cond sub pod time code
1             # Copyright 2012 Jeffrey Kegler
2             # This file is part of Marpa::PP. Marpa::PP 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::PP 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::PP. If not, see
14             # http://www.gnu.org/licenses/.
15              
16             package Marpa::PP::Grammar;
17              
18 44     44   1692 use 5.010;
  44         163  
  44         2629  
19 44     44   265 use warnings;
  44         107  
  44         1777  
20              
21             # There's a problem with this perlcritic check
22             # as of 9 Aug 2010
23             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
24 44     44   234 no warnings qw(recursion qw);
  44         89  
  44         2268  
25             ## use critic
26              
27 44     44   242 use strict;
  44         145  
  44         1807  
28              
29             # It's all integers, except for the version number
30 44     44   371 use integer;
  44         75  
  44         270  
31 44     44   86624 use utf8;
  44         496  
  44         256  
32              
33 44     44   2393 use vars qw($VERSION $STRING_VERSION);
  44         176  
  44         6206  
34             $VERSION = '0.014000';
35             $STRING_VERSION = $VERSION;
36             {
37             ## no critic (BuiltinFunctions::ProhibitStringyEval)
38             ## no critic (ValuesAndExpressions::RequireConstantVersion)
39             $VERSION = eval $VERSION;
40             }
41              
42             BEGIN {
43 44     44   458 my $structure = <<'END_OF_STRUCTURE';
44             :package=Marpa::PP::Internal::Symbol
45              
46             ID
47             NAME
48              
49             =LAST_BASIC_DATA_FIELD
50              
51             NULL_ALIAS { for a non-nullable symbol,
52             ref of a its nulling alias,
53             if there is one
54             otherwise undef }
55              
56             NULLING { always is null? }
57             RANKING_ACTION
58             NULL_VALUE { null value }
59              
60             NULLABLE { The number of nullable symbols
61             the symbol represents,
62             0 if the symbol is not nullable. }
63              
64             =LAST_EVALUATOR_FIELD
65              
66             TERMINAL { terminal? }
67              
68             =LAST_RECOGNIZER_FIELD
69              
70             LH_RULE_IDS { rules with this as the lhs,
71             as a ref to an array of rule refs }
72              
73             RH_RULE_IDS { rules with this in the rhs,
74             as a ref to an array of rule refs }
75              
76             ACCESSIBLE { reachable from start symbol? }
77             PRODUCTIVE { reachable from input symbol? }
78             START { is one of the start symbols? }
79             COUNTED { used on rhs of counted rule? }
80              
81             WARN_IF_NO_NULL_VALUE { should have a null value -- warn
82             if not }
83              
84             =LAST_FIELD
85             END_OF_STRUCTURE
86 44         206 Marpa::PP::offset($structure);
87             } ## end BEGIN
88              
89             BEGIN {
90 44     44   125 my $structure = <<'END_OF_STRUCTURE';
91              
92             :package=Marpa::PP::Internal::Rule
93              
94             ID
95             LHS { ref of the left hand symbol }
96             RHS { array of symbol refs }
97             =LAST_BASIC_DATA_FIELD
98              
99             USED { Use this rule in NFA? }
100             ACTION { action for this rule as specified by user }
101             RANKING_ACTION
102             VIRTUAL_LHS
103             VIRTUAL_RHS
104             DISCARD_SEPARATION
105             REAL_SYMBOL_COUNT
106             CYCLE { Can this rule be part of a cycle? }
107             VIRTUAL_CYCLE { Is this rule part of a cycle from the virtual
108             point of view? }
109             VIRTUAL_START
110             VIRTUAL_END
111             ORIGINAL_RULE { for a rewritten rule, the original }
112              
113             =LAST_EVALUATOR_FIELD
114             =LAST_RECOGNIZER_FIELD
115              
116             ACCESSIBLE { reachable from start symbol? }
117             PRODUCTIVE { reachable from input symbol? }
118              
119             =LAST_FIELD
120              
121             END_OF_STRUCTURE
122 44         253 Marpa::PP::offset($structure);
123             } ## end BEGIN
124              
125             BEGIN {
126 44     44   113 my $structure = <<'END_OF_STRUCTURE';
127              
128             :package=Marpa::PP::Internal::NFA
129              
130             ID
131             NAME
132             ITEM { an LR(0) item }
133             TRANSITION { the transitions, as a hash from symbol name to NFA states }
134             AT_NULLING { dot just before a nullable symbol? }
135             COMPLETE { rule is complete? }
136              
137             END_OF_STRUCTURE
138 44         179 Marpa::PP::offset($structure);
139             } ## end BEGIN
140              
141             BEGIN {
142 44     44   108 my $structure = <<'END_OF_STRUCTURE';
143              
144             :package=Marpa::PP::Internal::AHFA
145              
146             ID
147             NAME
148             =LAST_BASIC_DATA_FIELD
149              
150             COMPLETE_RULES { an array of lists of the complete rules,
151             indexed by lhs }
152              
153             START_RULE { the start rule }
154              
155             =LAST_EVALUATOR_FIELD
156              
157             TRANSITION { the transitions, as a hash
158             from symbol name to references to arrays
159             of AHFA states }
160              
161             COMPLETE_LHS { an array of the lhs's of complete rules }
162              
163             RESET_ORIGIN { reset origin for this state? }
164              
165             =LAST_RECOGNIZER_FIELD
166              
167             LEO_COMPLETION { Is this a Leo completion state? }
168              
169             NFA_STATES { in an AHFA: an array of NFA states }
170              
171             =LAST_FIELD
172              
173             END_OF_STRUCTURE
174 44         183 Marpa::PP::offset($structure);
175             } ## end BEGIN
176              
177             BEGIN {
178 44     44   125 my $structure = <<'END_OF_STRUCTURE';
179              
180             :package=Marpa::PP::Internal::LR0_item
181              
182             RULE
183             POSITION
184              
185             END_OF_STRUCTURE
186 44         191 Marpa::PP::offset($structure);
187             } ## end BEGIN
188              
189             BEGIN {
190 44     44   115 my $structure = <<'END_OF_STRUCTURE';
191              
192             :package=Marpa::PP::Internal::Grammar
193              
194             RULES { array of rule refs }
195             SYMBOLS { array of symbol refs }
196             AHFA { array of states }
197             PHASE { the grammar's phase }
198             ACTIONS { Default package in which to find actions }
199             DEFAULT_ACTION { Action for rules without one }
200             CYCLE_RANKING_ACTION { Action for ranking rules which cycle }
201             HAS_CYCLE { Does this grammar have a cycle? }
202             TRACE_FILE_HANDLE
203             STRIP { Boolean. If true, strip unused data to save space. }
204             LHS_TERMINALS { Boolean. If true, LHS terminals are allowed. }
205             WARNINGS { print warnings about grammar? }
206             TRACING { master flag, set if any tracing is being done
207             (to control overhead for non-tracing processes) }
208              
209             =LAST_BASIC_DATA_FIELD
210              
211             { === Evaluator Fields === }
212              
213             TERMINAL_NAMES { hash of terminal symbols, by name }
214             SYMBOL_HASH { hash to symbol ID by name of symbol refs }
215             DEFAULT_NULL_VALUE { default value for nulled symbols }
216             ACTION_OBJECT
217             INFINITE_ACTION
218              
219             =LAST_EVALUATOR_FIELD
220              
221             PROBLEMS { fatal problems }
222             START_STATES { ref to array of the start states }
223              
224             =LAST_RECOGNIZER_FIELD
225              
226             RULE_SIGNATURE_HASH
227             START { ref to start symbol }
228             START_NAME { name of original symbol }
229             NFA { array of states }
230             AHFA_BY_NAME { hash from AHFA name to AHFA reference }
231             NULLABLE_SYMBOL { array of refs of the nullable symbols }
232             INACCESSIBLE_OK
233             UNPRODUCTIVE_OK
234             TRACE_RULES
235              
236             =LAST_FIELD
237              
238             END_OF_STRUCTURE
239 44         173 Marpa::PP::offset($structure);
240             } ## end BEGIN
241              
242             package Marpa::PP::Internal::Grammar;
243              
244 44     44   98733 use POSIX qw(ceil);
  44         764817  
  44         479  
245              
246             # values for grammar phases
247             BEGIN {
248 44     44   76963 my $structure = <<'END_OF_STRUCTURE';
249              
250             :package=Marpa::PP::Internal::Phase
251             NEW RULES PRECOMPUTED
252              
253             END_OF_STRUCTURE
254 44         437 Marpa::PP::offset($structure);
255             } ## end BEGIN
256              
257             sub phase_description {
258 0     0   0 my $phase = shift;
259 0 0       0 return 'grammar without rules'
260             if $phase == Marpa::PP::Internal::Phase::NEW;
261 0 0       0 return 'grammar with rules entered'
262             if $phase == Marpa::PP::Internal::Phase::RULES;
263 0 0       0 return 'precomputed grammar'
264             if $phase == Marpa::PP::Internal::Phase::PRECOMPUTED;
265 0         0 return 'unknown phase';
266             } ## end sub phase_description
267              
268             package Marpa::PP::Internal::Grammar;
269              
270 44     44   570 use English qw( -no_match_vars );
  44         102  
  44         697  
271              
272             # Longest RHS is 2**28-1. It's 28 bits, not 32, so
273             # it will fit in the internal priorities computed
274             # for the CHAF rules
275 44     44   38047 use constant RHS_LENGTH_MASK => ~(0x7ffffff);
  44         111  
  44         79328  
276              
277             sub Marpa::PP::Internal::code_problems {
278 6     6 0 19 my $args = shift;
279              
280 6         7 my $grammar;
281             my $fatal_error;
282 6         12 my $warnings = [];
283 6         15 my $where = '?where?';
284 6         6 my $long_where;
285 6         15 my @msg = ();
286 6         11 my $eval_value;
287 6         10 my $eval_given = 0;
288              
289 6         19 push @msg, q{=} x 60, "\n";
290 6         15 while ( my ( $arg, $value ) = each %{$args} ) {
  42         141  
291 36         49 given ($arg) {
292 36         53 when ('fatal_error') { $fatal_error = $value }
  6         17  
293 30         44 when ('grammar') { $grammar = $value }
  6         18  
294 24         32 when ('where') { $where = $value }
  6         18  
295 18         26 when ('long_where') { $long_where = $value }
  6         18  
296 12         20 when ('warnings') { $warnings = $value }
  6         16  
297 6         18 when ('eval_ok') {
298 6         6 $eval_value = $value;
299 6         16 $eval_given = 1;
300             }
301 0         0 default { push @msg, "Unknown argument to code_problems: $arg" };
  0         0  
302             } ## end given
303             } ## end while ( my ( $arg, $value ) = each %{$args} )
304              
305 6         13 my @problem_line = ();
306 6         11 my $max_problem_line = -1;
307 6         9 for my $warning_data ( @{$warnings} ) {
  6         17  
308 4         9 my ( $warning, $package, $filename, $problem_line ) =
309 4         4 @{$warning_data};
310 4         6 $problem_line[$problem_line] = 1;
311 4         15 $max_problem_line = List::Util::max $problem_line, $max_problem_line;
312             } ## end for my $warning_data ( @{$warnings} )
313              
314 6   33     21 $long_where //= $where;
315              
316 6         9 my $warnings_count = scalar @{$warnings};
  6         19  
317             {
318 6         10 my @problems;
  6         9  
319 6   66     50 my $false_eval = $eval_given && !$eval_value && !$fatal_error;
320 6 50       17 if ($false_eval) {
321 0         0 push @problems, '* THE MARPA SEMANTICS RETURNED A PERL FALSE',
322             'Marpa::PP requires its semantics to return a true value';
323             }
324 6 100       15 if ($fatal_error) {
325 4         13 push @problems, '* THE MARPA SEMANTICS PRODUCED A FATAL ERROR';
326             }
327 6 100       14 if ($warnings_count) {
328 2         7 push @problems,
329             "* THERE WERE $warnings_count WARNING(S) IN THE MARPA SEMANTICS:",
330             'Marpa treats warnings as fatal errors';
331             }
332 6 50       20 if ( not scalar @problems ) {
333 0         0 push @msg, '* THERE WAS A FATAL PROBLEM IN THE MARPA SEMANTICS';
334             }
335 6         28 push @msg, ( join "\n", @problems ) . "\n";
336             }
337              
338 6         45 push @msg, "* THIS IS WHAT MARPA WAS DOING WHEN THE PROBLEM OCCURRED:\n"
339             . $long_where . "\n";
340              
341 6         21 for my $warning_ix ( 0 .. ( $warnings_count - 1 ) ) {
342 4         11 push @msg, "* WARNING MESSAGE NUMBER $warning_ix:\n";
343 4         8 my $warning_message = $warnings->[$warning_ix]->[0];
344 4         46 $warning_message =~ s/\n*\z/\n/xms;
345 4         12 push @msg, $warning_message;
346             } ## end for my $warning_ix ( 0 .. ( $warnings_count - 1 ) )
347              
348 6 100       19 if ($fatal_error) {
349 4         13 push @msg, "* THIS WAS THE FATAL ERROR MESSAGE:\n";
350 4         9 my $fatal_error_message = $fatal_error;
351 4         86 $fatal_error_message =~ s/\n*\z/\n/xms;
352 4         11 push @msg, $fatal_error_message;
353             } ## end if ($fatal_error)
354              
355 6         14 push @msg, q{* ONE PLACE TO LOOK FOR THE PROBLEM IS IN THE CODE};
356 6         4420 Marpa::PP::exception(@msg);
357             } ## end sub Marpa::PP::Internal::code_problems
358              
359             package Marpa::PP::Internal::Grammar;
360              
361             sub Marpa::PP::Grammar::new {
362 82     82 1 78911 my ( $class, @arg_hashes ) = @_;
363              
364 82         257 my $grammar = [];
365 82         447 bless $grammar, 'Marpa::PP::Grammar';
366              
367             # set the defaults and the default defaults
368 82         750 $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE] = *STDERR;
369              
370 82         278 $grammar->[Marpa::PP::Internal::Grammar::LHS_TERMINALS] = 1;
371 82         307 $grammar->[Marpa::PP::Internal::Grammar::TRACE_RULES] = 0;
372 82         215 $grammar->[Marpa::PP::Internal::Grammar::TRACING] = 0;
373 82         243 $grammar->[Marpa::PP::Internal::Grammar::STRIP] = 1;
374 82         197 $grammar->[Marpa::PP::Internal::Grammar::WARNINGS] = 1;
375 82         234 $grammar->[Marpa::PP::Internal::Grammar::INACCESSIBLE_OK] = {};
376 82         254 $grammar->[Marpa::PP::Internal::Grammar::UNPRODUCTIVE_OK] = {};
377 82         247 $grammar->[Marpa::PP::Internal::Grammar::INFINITE_ACTION] = 'fatal';
378              
379 82         262 $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS] = [];
380 82         205 $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH] = {};
381 82         239 $grammar->[Marpa::PP::Internal::Grammar::RULES] = [];
382 82         218 $grammar->[Marpa::PP::Internal::Grammar::RULE_SIGNATURE_HASH] = {};
383 82         270 $grammar->[Marpa::PP::Internal::Grammar::AHFA_BY_NAME] = {};
384 82         237 $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
385             Marpa::PP::Internal::Phase::NEW;
386              
387 82         467 $grammar->set(@arg_hashes);
388 81         335 return $grammar;
389             } ## end sub Marpa::PP::Grammar::new
390              
391 44         1382578 use constant GRAMMAR_OPTIONS => [
392             qw{
393             action_object
394             actions
395             cycle_ranking_action
396             infinite_action
397             default_action
398             default_null_value
399             inaccessible_ok
400             lhs_terminals
401             rules
402             start
403             strip
404             symbols
405             terminals
406             trace_file_handle
407             trace_rules
408             unproductive_ok
409             warnings
410             }
411 44     44   364 ];
  44         102  
412              
413             sub Marpa::PP::Grammar::set {
414 104     104 1 2328 my ( $grammar, @arg_hashes ) = @_;
415              
416             # set trace_fh even if no tracing, because we may turn it on in this method
417 104         363 my $trace_fh =
418             $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE];
419 104         259 my $tracing = $grammar->[Marpa::PP::Internal::Grammar::TRACING];
420 104         238 my $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE];
421              
422 104         282 for my $args (@arg_hashes) {
423              
424 115         293 my $ref_type = ref $args;
425 115 50 33     1041 if ( not $ref_type or $ref_type ne 'HASH' ) {
426 0   0     0 Carp::croak(
427             'Marpa::PP args as ref to HASH, got ',
428             ( "ref to $ref_type" || 'non-reference' ),
429             ' instead'
430             );
431             } ## end if ( not $ref_type or $ref_type ne 'HASH' )
432 115 50       235 if (my @bad_options =
  405         2362  
433 115         526 grep { not $_ ~~ Marpa::PP::Internal::Grammar::GRAMMAR_OPTIONS }
434             keys %{$args}
435             )
436             {
437 0         0 Carp::croak( 'Unknown option(s) for Marpa::PP Grammar: ',
438             join q{ }, @bad_options );
439             } ## end if ( my @bad_options = grep { not $_ ~~ ...})
440              
441 115 100       561 if ( defined( my $value = $args->{'trace_file_handle'} ) ) {
442 7         23 $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE] =
443             $value;
444             }
445              
446 115 50       671 if ( defined( my $value = $args->{'trace_rules'} ) ) {
447 0         0 $grammar->[Marpa::PP::Internal::Grammar::TRACE_RULES] = $value;
448 0 0       0 if ($value) {
449 0         0 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
450 0         0 my $rule_count = @{$rules};
  0         0  
451 0 0       0 say {$trace_fh} 'Setting trace_rules'
  0         0  
452             or Marpa::PP::exception("Could not print: $ERRNO");
453 0 0       0 if ($rule_count) {
454 0 0       0 say {$trace_fh}
  0         0  
455             "Warning: Setting trace_rules after $rule_count rules have been defined"
456             or Marpa::PP::exception("Could not print: $ERRNO");
457             }
458 0         0 $grammar->[Marpa::PP::Internal::Grammar::TRACING] = 1;
459             } ## end if ($value)
460             } ## end if ( defined( my $value = $args->{'trace_rules'} ) )
461              
462             # First pass options: These affect processing of other
463             # options and are expected to take force for the other
464             # options, even if specified afterwards
465              
466             # Second pass options
467 115 100       459 if ( defined( my $value = $args->{'symbols'} ) ) {
468 12 50       44 Marpa::PP::exception(
469             'symbols option not allowed after grammar is precomputed')
470             if $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED;
471 12 50       50 Marpa::PP::exception('symbols value must be REF to HASH')
472             if ref $value ne 'HASH';
473 12         31 while ( my ( $symbol, $properties ) = each %{$value} ) {
  31         205  
474 19         76 assign_user_symbol( $grammar, $symbol, $properties );
475             }
476 12         33 $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
477             Marpa::PP::Internal::Phase::RULES;
478             } ## end if ( defined( my $value = $args->{'symbols'} ) )
479              
480 115 100       576 if ( defined( my $value = $args->{'lhs_terminals'} ) ) {
481 7 50       37 Marpa::PP::exception(
482             'lhs_terminals option not allowed after grammar is precomputed'
483             ) if $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED;
484 7         19 $grammar->[Marpa::PP::Internal::Grammar::LHS_TERMINALS] = $value;
485 7         19 $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
486             Marpa::PP::Internal::Phase::RULES;
487             } ## end if ( defined( my $value = $args->{'lhs_terminals'} ))
488              
489 115 100       545 if ( defined( my $value = $args->{'terminals'} ) ) {
490 58 50       197 Marpa::PP::exception(
491             'terminals option not allowed after grammar is precomputed')
492             if $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED;
493 58 50       235 Marpa::PP::exception('terminals value must be REF to ARRAY')
494             if ref $value ne 'ARRAY';
495 58         124 for my $symbol ( @{$value} ) {
  58         149  
496 119         5184 assign_user_symbol( $grammar, $symbol, { terminal => 1 } );
497             }
498 58         178 $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
499             Marpa::PP::Internal::Phase::RULES;
500             } ## end if ( defined( my $value = $args->{'terminals'} ) )
501              
502 115 100       596 if ( defined( my $value = $args->{'start'} ) ) {
503 81 50       315 Marpa::PP::exception(
504             'start option not allowed after grammar is precomputed')
505             if $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED;
506 81         253 $grammar->[Marpa::PP::Internal::Grammar::START_NAME] = $value;
507             } ## end if ( defined( my $value = $args->{'start'} ) )
508              
509 115 100       439 if ( defined( my $value = $args->{'rules'} ) ) {
510 82 50       288 Marpa::PP::exception(
511             'rules option not allowed after grammar is precomputed')
512             if $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED;
513 82 50       345 Marpa::PP::exception('rules value must be reference to array')
514             if ref $value ne 'ARRAY';
515 82         380 add_user_rules( $grammar, $value );
516 81         214 $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
517             Marpa::PP::Internal::Phase::RULES;
518             } ## end if ( defined( my $value = $args->{'rules'} ) )
519              
520 114 100       482 if ( defined( my $value = $args->{'default_null_value'} ) ) {
521 30         73 $grammar->[Marpa::PP::Internal::Grammar::DEFAULT_NULL_VALUE] =
522             $value;
523             }
524              
525 114 100       493 if ( defined( my $value = $args->{'actions'} ) ) {
526 15         36 $grammar->[Marpa::PP::Internal::Grammar::ACTIONS] = $value;
527             }
528              
529 114 100       413 if ( defined( my $value = $args->{'action_object'} ) ) {
530 1         2 $grammar->[Marpa::PP::Internal::Grammar::ACTION_OBJECT] = $value;
531             }
532              
533 114 50       438 if ( defined( my $value = $args->{'cycle_ranking_action'} ) ) {
534 0         0 $grammar->[Marpa::PP::Internal::Grammar::CYCLE_RANKING_ACTION] =
535             $value;
536             }
537              
538 114 100       442 if ( defined( my $value = $args->{'default_action'} ) ) {
539 51         118 $grammar->[Marpa::PP::Internal::Grammar::DEFAULT_ACTION] = $value;
540             }
541              
542 114 100       390 if ( defined( my $value = $args->{'strip'} ) ) {
543 44         97 $grammar->[Marpa::PP::Internal::Grammar::STRIP] = $value;
544             }
545              
546 114 100       454 if ( defined( my $value = $args->{'infinite_action'} ) ) {
547 8 50 33     59 if ( $value && $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED )
548             {
549 0 0       0 say {$trace_fh}
  0         0  
550             '"infinite_action" option is useless after grammar is precomputed'
551             or Marpa::PP::exception("Could not print: $ERRNO");
552             } ## end if ( $value && $phase >= ...)
553             Marpa::PP::exception(
554 8 50       53 q{infinite_action must be 'warn', 'quiet' or 'fatal'})
555             if not $value ~~ [qw(warn quiet fatal)];
556 8         229 $grammar->[Marpa::PP::Internal::Grammar::INFINITE_ACTION] =
557             $value;
558             } ## end if ( defined( my $value = $args->{'infinite_action'}...))
559              
560 114 100       531 if ( defined( my $value = $args->{'warnings'} ) ) {
561 9 50 66     62 if ( $value && $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED )
562             {
563 0 0       0 say {$trace_fh}
  0         0  
564             q{"warnings" option is useless after grammar is precomputed}
565             or Marpa::PP::exception("Could not print: $ERRNO");
566             } ## end if ( $value && $phase >= ...)
567 9         212 $grammar->[Marpa::PP::Internal::Grammar::WARNINGS] = $value;
568             } ## end if ( defined( my $value = $args->{'warnings'} ) )
569              
570 114 50       412 if ( defined( my $value = $args->{'inaccessible_ok'} ) ) {
571 0 0 0     0 if ( $value && $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED )
572             {
573 0 0       0 say {$trace_fh}
  0         0  
574             q{"inaccessible_ok" option is useless after grammar is precomputed}
575             or Marpa::PP::exception("Could not print: $ERRNO");
576              
577             } ## end if ( $value && $phase >= ...)
578 0         0 given ( ref $value ) {
579 0         0 when (q{}) {
580 0   0     0 $value //= {
581             }
582             }
583 0         0 when ('ARRAY') {
584 0         0 $value = {
585 0         0 map { ( $_, 1 ) } @{$value}
  0         0  
586             }
587             }
588 0         0 default {
589 0         0 Marpa::PP::exception(
590             'value of inaccessible_ok option must be boolean or an array ref'
591             )
592             }
593             } ## end given
594 0         0 $grammar->[Marpa::PP::Internal::Grammar::INACCESSIBLE_OK] =
595             $value;
596             } ## end if ( defined( my $value = $args->{'inaccessible_ok'}...))
597              
598 114 50       666 if ( defined( my $value = $args->{'unproductive_ok'} ) ) {
599 0 0 0     0 if ( $value && $phase >= Marpa::PP::Internal::Phase::PRECOMPUTED )
600             {
601 0 0       0 say {$trace_fh}
  0         0  
602             q{"unproductive_ok" option is useless after grammar is precomputed}
603             or Marpa::PP::exception("Could not print: $ERRNO");
604             } ## end if ( $value && $phase >= ...)
605 0         0 given ( ref $value ) {
606 0         0 when (q{}) {
607 0   0     0 $value //= {
608             };
609             }
610 0         0 when ('ARRAY') {
611 0         0 $value = {
612 0         0 map { ( $_, 1 ) } @{$value}
  0         0  
613             }
614             }
615 0         0 default {
616 0         0 Marpa::PP::exception(
617             'value of unproductive_ok option must be boolean or an array ref'
618             )
619             }
620             } ## end given
621 0         0 $grammar->[Marpa::PP::Internal::Grammar::UNPRODUCTIVE_OK] =
622             $value;
623             } ## end if ( defined( my $value = $args->{'unproductive_ok'}...))
624              
625             } ## end for my $args (@arg_hashes)
626              
627 103         796 return 1;
628             } ## end sub Marpa::PP::Grammar::set
629              
630             =begin Implementation:
631              
632             In order to automatically ELIMINATE inaccessible and unproductive
633             productions from a grammar, you have to first eliminate the
634             unproductive productions, THEN the inaccessible ones. I don't do
635             this in the below.
636              
637             The reason is my purposes are primarily diagnostic. The difference
638             shows in the case of an unproductive start symbol. Following the
639             correct procedure for automatically cleaning the grammar, I would
640             have to regard the start symbol and its productions as eliminated
641             and therefore go on to report every other production and symbol as
642             inaccessible. Almost certainly all these inaccessiblity reports,
643             while theoretically correct, are irrelevant, since the user will
644             probably respond by making the start symbol productive, and the
645             extra "information" would only get in the way.
646              
647             The downside is that in a few uncommon cases, a user relying entirely
648             on the Marpa::PP warnings to clean up his grammar will have to go through
649             more than a single pass of the diagnostics. I think even those
650             users will prefer less cluttered diagnostics, and I'm sure most
651             users will.
652              
653             =end Implementation:
654              
655             =cut
656              
657             sub Marpa::PP::Grammar::precompute {
658 81     81 1 1042 my $grammar = shift;
659              
660 81         941 my $tracing = $grammar->[Marpa::PP::Internal::Grammar::TRACING];
661 81         245 my $trace_fh =
662             $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE];
663              
664 81         191 my $problems = $grammar->[Marpa::PP::Internal::Grammar::PROBLEMS];
665 81 50       305 if ($problems) {
666 0         0 Marpa::PP::exception(
667             Marpa::PP::Grammar::show_problems($grammar),
668             "Second attempt to precompute grammar with fatal problems\n",
669             'Marpa::PP cannot proceed'
670             );
671             } ## end if ($problems)
672              
673 81         268 my $phase = $grammar->[Marpa::PP::Internal::Grammar::PHASE];
674              
675             # Be idempotent. If the grammar is already precomputed, just
676             # return success without doing anything.
677 81 50       307 if ( $phase == Marpa::PP::Internal::Phase::PRECOMPUTED ) {
678 0         0 return $grammar;
679             }
680              
681 81 50       465 if ( $phase != Marpa::PP::Internal::Phase::RULES ) {
682 0         0 Marpa::PP::exception(
683             "Attempt to precompute grammar in inappropriate state\nAttempt to precompute ",
684             phase_description($phase)
685             );
686             } ## end if ( $phase != Marpa::PP::Internal::Phase::RULES )
687              
688             SET_TERMINALS: {
689 81         139 my $lhs_terminals_ok =
  81         172  
690             $grammar->[Marpa::PP::Internal::Grammar::LHS_TERMINALS];
691 81         475 my $distinguished = terminals_distinguished($grammar);
692 81 100 100     581 if ( $distinguished and not $lhs_terminals_ok ) {
693 1         5 check_lhs_non_terminal($grammar);
694 0         0 last SET_TERMINALS;
695             }
696 80 100       324 last SET_TERMINALS if $distinguished;
697 20 100       87 if ( not $lhs_terminals_ok ) {
698 6         35 mark_non_lhs_terminal($grammar);
699 6         13 last SET_TERMINALS;
700             }
701 14 50       60 if ( has_empty_rule($grammar) ) {
702 0         0 Marpa::PP::exception(
703             'A grammar with empty rules must mark its terminals or unset lhs_terminals'
704             );
705             }
706 14         102 mark_all_symbols_terminal($grammar);
707             } ## end SET_TERMINALS:
708              
709 80         388 nulling($grammar);
710 80 50       315 nullable($grammar) or return $grammar;
711 79         485 productive($grammar);
712 79 50       352 check_start($grammar) or return $grammar;
713 76         313 accessible($grammar);
714 76         485 rewrite_as_CHAF($grammar);
715 76         502 detect_infinite($grammar);
716 76         980 create_NFA($grammar);
717 76         429 create_AHFA($grammar);
718 76         373 mark_leo_states($grammar);
719              
720 376         2048 $grammar->[Marpa::PP::Internal::Grammar::TERMINAL_NAMES] = {
721 996         1787 map { ( $_->[Marpa::PP::Internal::Symbol::NAME] => 1 ) }
722 76         210 grep { $_->[Marpa::PP::Internal::Symbol::TERMINAL] }
723 76         153 @{ $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS] }
724             };
725              
726 76 100 66     1017 if ($grammar->[Marpa::PP::Internal::Grammar::WARNINGS]
727             and ref(
728             my $ok = $grammar->[Marpa::PP::Internal::Grammar::INACCESSIBLE_OK]
729             ) eq 'HASH'
730             )
731             {
732 75         404 SYMBOL:
733 75         166 for my $symbol (
734             @{ Marpa::PP::Grammar::inaccessible_symbols($grammar) } )
735             {
736              
737             # Inaccessible internal symbols may be created
738             # from inaccessible use symbols -- ignore these.
739             # This assumes that Marpa::PP's logic
740             # is correct and that
741             # it is not creating inaccessible symbols from
742             # accessible ones.
743 2 50       10 next SYMBOL if $symbol =~ /\]/xms;
744 2 50       6 next SYMBOL if $ok->{$symbol};
745 2 50       3 say {$trace_fh} "Inaccessible symbol: $symbol"
  2         20  
746             or Marpa::PP::exception("Could not print: $ERRNO");
747             } ## end for my $symbol ( @{ Marpa::PP::Grammar::inaccessible_symbols...})
748             } ## end if ( $grammar->[Marpa::PP::Internal::Grammar::WARNINGS...])
749              
750 76 100 66     995 if ($grammar->[Marpa::PP::Internal::Grammar::WARNINGS]
751             and ref(
752             my $ok = $grammar->[Marpa::PP::Internal::Grammar::UNPRODUCTIVE_OK]
753             ) eq 'HASH'
754             )
755             {
756 75         310 SYMBOL:
757 75         143 for my $symbol (
758             @{ Marpa::PP::Grammar::unproductive_symbols($grammar) } )
759             {
760              
761             # Unproductive internal symbols may be created
762             # from unproductive use symbols -- ignore these.
763             # This assumes that Marpa::PP's logic
764             # is correct and that
765             # it is not creating unproductive symbols from
766             # productive ones.
767 0 0       0 next SYMBOL if $symbol =~ /\]/xms;
768 0 0       0 next SYMBOL if $ok->{$symbol};
769 0 0       0 say {$trace_fh} "Unproductive symbol: $symbol"
  0         0  
770             or Marpa::PP::exception("Could not print: $ERRNO");
771             } ## end for my $symbol ( @{ Marpa::PP::Grammar::unproductive_symbols...})
772             } ## end if ( $grammar->[Marpa::PP::Internal::Grammar::WARNINGS...])
773              
774 76 100       427 if ( $grammar->[Marpa::PP::Internal::Grammar::WARNINGS] ) {
775 75         231 SYMBOL:
776 75         149 for my $symbol (
777             @{ $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS] } )
778             {
779              
780             next SYMBOL
781 991 100       2205 if not $symbol
782             ->[Marpa::PP::Internal::Symbol::WARN_IF_NO_NULL_VALUE];
783             next SYMBOL
784 1 50       5 if $symbol->[Marpa::PP::Internal::Symbol::NULL_VALUE];
785 1         3 my $symbol_name = $symbol->[Marpa::PP::Internal::Symbol::NAME];
786 1 50       2 say {$trace_fh}
  1         11  
787             qq{Zero length sequence for symbol without null value: "$symbol_name"}
788             or Marpa::PP::exception("Could not print: $ERRNO");
789             } ## end for my $symbol ( @{ $grammar->[...]})
790             } ## end if ( $grammar->[Marpa::PP::Internal::Grammar::WARNINGS...])
791              
792 76         227 $grammar->[Marpa::PP::Internal::Grammar::PHASE] =
793             Marpa::PP::Internal::Phase::PRECOMPUTED;
794              
795 76 100       344 if ( $grammar->[Marpa::PP::Internal::Grammar::STRIP] ) {
796              
797 32         62 $#{$grammar} = Marpa::PP::Internal::Grammar::LAST_RECOGNIZER_FIELD;
  32         590  
798              
799 32         68 for my $symbol (
  32         106  
800             @{ $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS] } )
801             {
802 312         338 $#{$symbol} = Marpa::PP::Internal::Symbol::LAST_RECOGNIZER_FIELD;
  312         917  
803             }
804              
805 32         82 for my $rule ( @{ $grammar->[Marpa::PP::Internal::Grammar::RULES] } )
  32         106  
806             {
807 373         386 $#{$rule} = Marpa::PP::Internal::Rule::LAST_RECOGNIZER_FIELD;
  373         855  
808             }
809              
810 32         73 for my $AHFA ( @{ $grammar->[Marpa::PP::Internal::Grammar::AHFA] } ) {
  32         1257  
811 451         529 $#{$AHFA} = Marpa::PP::Internal::AHFA::LAST_RECOGNIZER_FIELD;
  451         2675  
812             }
813              
814             } ## end if ( $grammar->[Marpa::PP::Internal::Grammar::STRIP])
815              
816 76         505 return $grammar;
817              
818             } ## end sub Marpa::PP::Grammar::precompute
819              
820             sub Marpa::PP::Grammar::show_problems {
821 2     2 1 382 my ($grammar) = @_;
822              
823 2         4 my $problems = $grammar->[Marpa::PP::Internal::Grammar::PROBLEMS];
824 2 100       7 if ($problems) {
825 1         2 my $problem_count = scalar @{$problems};
  1         1  
826             return
827 1         396 "Grammar has $problem_count problems:\n"
828 1         8 . ( join "\n", @{$problems} ) . "\n";
829             } ## end if ($problems)
830 1         3 return "Grammar has no problems\n";
831             } ## end sub Marpa::PP::Grammar::show_problems
832              
833             sub Marpa::PP::show_symbol {
834 95     95 0 134 my ($symbol) = @_;
835 95         129 my $text = q{};
836 95         107 my $stripped = $#{$symbol} < Marpa::PP::Internal::Symbol::LAST_FIELD;
  95         193  
837              
838 95         183 my $name = $symbol->[Marpa::PP::Internal::Symbol::NAME];
839 95         300 $text .= sprintf '%d: %s,', $symbol->[Marpa::PP::Internal::Symbol::ID],
840             $name;
841              
842 95 100       189 if ($stripped) { $text .= ' stripped' }
  10         16  
843             else {
844 85         271 $text .= sprintf ' lhs=[%s]',
845             join q{ },
846 85         111 @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
847              
848 85         295 $text .= sprintf ' rhs=[%s]',
849             join q{ },
850 85         120 @{ $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] };
851              
852             } ## end else [ if ($stripped) ]
853              
854 95         152 my $nullable = $symbol->[Marpa::PP::Internal::Symbol::NULLABLE];
855 95 100       228 if ($nullable) {
856 32         49 $text .= ' nullable';
857             }
858              
859             ELEMENT:
860 95         403 for my $comment_element (
861             ( [ 1, 'unproductive', Marpa::PP::Internal::Symbol::PRODUCTIVE, ],
862             [ 1, 'inaccessible', Marpa::PP::Internal::Symbol::ACCESSIBLE, ],
863             [ 0, 'nulling', Marpa::PP::Internal::Symbol::NULLING, ],
864             [ 0, 'terminal', Marpa::PP::Internal::Symbol::TERMINAL, ],
865             )
866             )
867             {
868 380         407 my ( $reverse, $comment, $offset ) = @{$comment_element};
  380         618  
869 380 100       1095 next ELEMENT if not exists $symbol->[$offset];
870 262         333 my $value = $symbol->[$offset];
871 262 100       488 if ($reverse) { $value = !$value }
  170         230  
872 262 100       580 if ($value) { $text .= " $comment" }
  57         146  
873             } ## end for my $comment_element ( ( [ 1, 'unproductive', ...]))
874              
875 95         262 $text .= "\n";
876 95         462 return $text;
877              
878             } ## end sub Marpa::PP::show_symbol
879              
880             sub Marpa::PP::Grammar::show_symbols {
881 10     10 1 1622 my ($grammar) = @_;
882 10         29 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
883 10         34 my $text = q{};
884 10         25 for my $symbol_ref ( @{$symbols} ) {
  10         31  
885 95         209 $text .= Marpa::PP::show_symbol($symbol_ref);
886             }
887 10         147 return $text;
888             } ## end sub Marpa::PP::Grammar::show_symbols
889              
890             sub Marpa::PP::Grammar::show_nulling_symbols {
891 3     3 0 9 my ($grammar) = @_;
892 3         10 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
893 30         86 return 'stripped_'
894 30         34 if scalar grep { $#{$_} < Marpa::PP::Internal::Symbol::LAST_FIELD }
  3         11  
895 3 100       9 @{$symbols};
896 8         34 return join q{ }, sort map { $_->[Marpa::PP::Internal::Symbol::NAME] }
  20         32  
897 2         7 grep { $_->[Marpa::PP::Internal::Symbol::NULLING] } @{$symbols};
  2         6  
898             } ## end sub Marpa::PP::Grammar::show_nulling_symbols
899              
900             sub Marpa::PP::Grammar::show_nullable_symbols {
901 3     3 0 11 my ($grammar) = @_;
902 3 100       23 return 'stripped_'
903             if not
904             exists $grammar->[Marpa::PP::Internal::Grammar::NULLABLE_SYMBOL];
905 2         5 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::NULLABLE_SYMBOL];
906 8         34 return join q{ },
907 2         5 sort map { $_->[Marpa::PP::Internal::Symbol::NAME] } @{$symbols};
  2         7  
908             } ## end sub Marpa::PP::Grammar::show_nullable_symbols
909              
910             sub Marpa::PP::Grammar::show_productive_symbols {
911 3     3 0 10 my ($grammar) = @_;
912 3         10 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
913 30         89 return 'stripped_'
914 30         39 if scalar grep { $#{$_} < Marpa::PP::Internal::Symbol::LAST_FIELD }
  3         9  
915 3 100       8 @{$symbols};
916 20         143 return join q{ }, sort map { $_->[Marpa::PP::Internal::Symbol::NAME] }
  20         38  
917 2         8 grep { $_->[Marpa::PP::Internal::Symbol::PRODUCTIVE] } @{$symbols};
  2         5  
918             } ## end sub Marpa::PP::Grammar::show_productive_symbols
919              
920             sub Marpa::PP::Grammar::show_accessible_symbols {
921 3     3 0 10 my ($grammar) = @_;
922 3         14 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
923 30         85 return 'stripped_'
924 30         33 if scalar grep { $#{$_} < Marpa::PP::Internal::Symbol::LAST_FIELD }
  3         11  
925 3 100       13 @{$symbols};
926 20         59 return join q{ }, sort map { $_->[Marpa::PP::Internal::Symbol::NAME] }
  20         36  
927 2         6 grep { $_->[Marpa::PP::Internal::Symbol::ACCESSIBLE] } @{$symbols};
  2         8  
928             } ## end sub Marpa::PP::Grammar::show_accessible_symbols
929              
930             sub Marpa::PP::Grammar::inaccessible_symbols {
931 75     75 0 159 my ($grammar) = @_;
932 75         198 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
933             return [
934 2         8 sort map { $_->[Marpa::PP::Internal::Symbol::NAME] }
  991         2071  
935 75         366 grep { !$_->[Marpa::PP::Internal::Symbol::ACCESSIBLE] }
936 75         199 @{$symbols}
937             ];
938             } ## end sub Marpa::PP::Grammar::inaccessible_symbols
939              
940             sub Marpa::PP::Grammar::unproductive_symbols {
941 75     75 0 185 my ($grammar) = @_;
942 75         278 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
943             return [
944 0         0 sort map { $_->[Marpa::PP::Internal::Symbol::NAME] }
  991         1925  
945 75         191 grep { !$_->[Marpa::PP::Internal::Symbol::PRODUCTIVE] }
946 75         168 @{$symbols}
947             ];
948             } ## end sub Marpa::PP::Grammar::unproductive_symbols
949              
950             sub Marpa::PP::brief_rule {
951 219     219 0 300 my ($rule) = @_;
952 219         284 my ( $lhs, $rhs, $rule_id ) = @{$rule}[
  219         510  
953             Marpa::PP::Internal::Rule::LHS, Marpa::PP::Internal::Rule::RHS,
954             Marpa::PP::Internal::Rule::ID
955             ];
956 219         573 my $text .= $rule_id . ': '
957             . $lhs->[Marpa::PP::Internal::Symbol::NAME] . ' ->';
958 219 100       238 if ( @{$rhs} ) {
  219         577  
959 383         973 $text .= q{ }
960             . (
961 197         599 join q{ }, map { $_->[Marpa::PP::Internal::Symbol::NAME] } @{$rhs}
  197         341  
962             );
963             } ## end if ( @{$rhs} )
964 219         827 return $text;
965             } ## end sub Marpa::PP::brief_rule
966              
967             sub Marpa::PP::brief_original_rule {
968 0     0 0 0 my ($rule) = @_;
969 0   0     0 my $original_rule = $rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE]
970             // $rule;
971 0         0 return Marpa::PP::brief_rule($original_rule);
972             } ## end sub Marpa::PP::brief_original_rule
973              
974             sub Marpa::PP::brief_virtual_rule {
975 0     0 0 0 my ( $rule, $dot_position ) = @_;
976 0         0 my $original_rule = $rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE];
977 0 0       0 if ( not defined $original_rule ) {
978 0 0       0 return Marpa::PP::show_dotted_rule( $rule, $dot_position )
979             if defined $dot_position;
980 0         0 return Marpa::PP::brief_rule($rule);
981             }
982              
983 0         0 my $rule_id = $rule->[Marpa::PP::Internal::Rule::ID];
984 0         0 my $original_rule_id = $original_rule->[Marpa::PP::Internal::Rule::ID];
985 0         0 my $original_lhs = $original_rule->[Marpa::PP::Internal::Rule::LHS];
986 0         0 my $chaf_rhs = $rule->[Marpa::PP::Internal::Rule::RHS];
987 0         0 my $original_rhs = $original_rule->[Marpa::PP::Internal::Rule::RHS];
988 0         0 my $chaf_start = $rule->[Marpa::PP::Internal::Rule::VIRTUAL_START];
989 0         0 my $chaf_end = $rule->[Marpa::PP::Internal::Rule::VIRTUAL_END];
990              
991 0 0       0 if ( not defined $chaf_start ) {
992 0 0       0 return "dot at $dot_position, virtual "
993             . Marpa::PP::brief_rule($original_rule)
994             if defined $dot_position;
995 0         0 return 'virtual ' . Marpa::PP::brief_rule($original_rule);
996             } ## end if ( not defined $chaf_start )
997              
998 0         0 my $text .= "(part of $original_rule_id) ";
999 0         0 $text .= $original_lhs->[Marpa::PP::Internal::Symbol::NAME] . ' ->';
1000 0         0 my @rhs_names =
1001 0         0 map { $_->[Marpa::PP::Internal::Symbol::NAME] } @{$original_rhs};
  0         0  
1002              
1003 0         0 my @chaf_symbol_start;
1004             my @chaf_symbol_end;
1005              
1006             # Mark the beginning and end of the non-CHAF symbols
1007             # in the CHAF rule.
1008 0         0 for my $chaf_ix ( $chaf_start .. $chaf_end ) {
1009 0         0 $chaf_symbol_start[$chaf_ix] = 1;
1010 0         0 $chaf_symbol_end[ $chaf_ix + 1 ] = 1;
1011             }
1012              
1013             # Mark the beginning and special CHAF symbol
1014             # for the "rest" of the rule.
1015 0 0       0 if ( $chaf_end < $#rhs_names ) {
1016 0         0 $chaf_symbol_start[ $chaf_end + 1 ] = 1;
1017 0         0 $chaf_symbol_end[ scalar @rhs_names ] = 1;
1018             }
1019              
1020             $dot_position =
1021 0 0       0 $dot_position >= scalar @{$chaf_rhs}
  0         0  
1022             ? scalar @rhs_names
1023             : ( $chaf_start + $dot_position );
1024              
1025 0         0 for ( 0 .. scalar @rhs_names ) {
1026 0         0 when ( defined $chaf_symbol_end[$_] ) { $text .= ' >'; continue }
  0         0  
  0         0  
1027 0         0 when ($dot_position) { $text .= q{ .}; continue; }
  0         0  
  0         0  
1028 0         0 when ( defined $chaf_symbol_start[$_] ) { $text .= ' <'; continue }
  0         0  
  0         0  
1029 0         0 when ( $_ < scalar @rhs_names ) {
1030 0         0 $text .= q{ } . $rhs_names[$_]
1031             }
1032             } ## end for ( 0 .. scalar @rhs_names )
1033              
1034 0         0 return $text;
1035              
1036             } ## end sub Marpa::PP::brief_virtual_rule
1037              
1038             sub Marpa::PP::show_rule {
1039 181     181 0 272 my ($rule) = @_;
1040              
1041 181         202 my $stripped = $#{$rule} < Marpa::PP::Internal::Rule::LAST_FIELD;
  181         363  
1042 181         335 my $rhs = $rule->[Marpa::PP::Internal::Rule::RHS];
1043 181         273 my @comment = ();
1044              
1045 181 100       189 if ( not( @{$rhs} ) ) { push @comment, 'empty'; }
  181         440  
  22         51  
1046              
1047 181 100       411 if ($stripped) { push @comment, 'stripped'; }
  15         18  
1048              
1049             ELEMENT:
1050 181         932 for my $comment_element (
1051             ( [ 1, '!used', Marpa::PP::Internal::Rule::USED, ],
1052             [ 1, 'unproductive', Marpa::PP::Internal::Rule::PRODUCTIVE, ],
1053             [ 1, 'inaccessible', Marpa::PP::Internal::Rule::ACCESSIBLE, ],
1054             [ 0, 'vlhs', Marpa::PP::Internal::Rule::VIRTUAL_LHS, ],
1055             [ 0, 'vrhs', Marpa::PP::Internal::Rule::VIRTUAL_RHS, ],
1056             [ 0, 'discard_sep',
1057             Marpa::PP::Internal::Rule::DISCARD_SEPARATION,
1058             ],
1059             )
1060             )
1061             {
1062 1086         1111 my ( $reverse, $comment, $offset ) = @{$comment_element};
  1086         1707  
1063 1086 100       2199 next ELEMENT if not exists $rule->[$offset];
1064 1056         1329 my $value = $rule->[$offset];
1065 1056 100       1830 if ($reverse) { $value = !$value }
  513         642  
1066 1056 100       2504 next ELEMENT if not $value;
1067 133         250 push @comment, $comment;
1068             } ## end for my $comment_element ( ( [ 1, '!used', ...]))
1069              
1070 181 100 100     1166 if ( $rule->[Marpa::PP::Internal::Rule::VIRTUAL_LHS]
1071             or $rule->[Marpa::PP::Internal::Rule::VIRTUAL_RHS] )
1072             {
1073 79         276 push @comment, sprintf 'real=%d',
1074             $rule->[Marpa::PP::Internal::Rule::REAL_SYMBOL_COUNT];
1075             } ## end if ( $rule->[Marpa::PP::Internal::Rule::VIRTUAL_LHS]...)
1076              
1077 181         365 my $text = Marpa::PP::brief_rule($rule);
1078              
1079 181 100       447 if (@comment) {
1080 124         400 $text .= q{ } . ( join q{ }, q{/*}, @comment, q{*/} );
1081             }
1082              
1083 181         640 return $text .= "\n";
1084              
1085             } # sub show_rule
1086              
1087             sub Marpa::PP::Grammar::show_rules {
1088 15     15 1 1820 my ($grammar) = @_;
1089 15         66 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1090 15         33 my $text;
1091              
1092 15         33 for my $rule ( @{$rules} ) {
  15         46  
1093 181         358 $text .= Marpa::PP::show_rule($rule);
1094             }
1095 15         125 return $text;
1096             } ## end sub Marpa::PP::Grammar::show_rules
1097              
1098             sub Marpa::PP::show_dotted_rule {
1099 415     415 0 535 my ( $rule, $dot_position ) = @_;
1100              
1101 415         852 my $text =
1102             $rule->[Marpa::PP::Internal::Rule::LHS]
1103             ->[Marpa::PP::Internal::Symbol::NAME] . q{ ->};
1104              
1105             # In the bocage, when we are starting a rule and
1106             # there is no current symbol, the position may
1107             # be -1.
1108             # Position has different semantics in the bocage, than in an LR-item.
1109             # In the bocage, the position is *AT* a symbol.
1110             # In the bocage the position is the number OF the current symbol.
1111             # An LR-item the position how far into the rule parsing has
1112             # proceded and is therefore between symbols (or at the end
1113             # or beginning or a rule).
1114             # Usually bocage position is one less than the analagous
1115             # LR-item position.
1116 415 50       864 if ( $dot_position < 0 ) {
1117 0         0 $text .= q{ !};
1118             }
1119              
1120 808         1742 my @rhs_names =
1121 415         738 map { $_->[Marpa::PP::Internal::Symbol::NAME] }
1122 415         455 @{ $rule->[Marpa::PP::Internal::Rule::RHS] };
1123              
1124 415         960 POSITION: for my $position ( 0 .. scalar @rhs_names ) {
1125 1223 100       2243 if ( $position == $dot_position ) {
1126 415         522 $text .= q{ .};
1127             }
1128 1223         1498 my $name = $rhs_names[$position];
1129 1223 100       2905 next POSITION if not defined $name;
1130 808         1262 $text .= " $name";
1131             } ## end for my $position ( 0 .. scalar @rhs_names )
1132              
1133 415         1267 return $text;
1134              
1135             } ## end sub Marpa::PP::show_dotted_rule
1136              
1137             sub Marpa::PP::show_item {
1138 379     379 0 436 my ($item) = @_;
1139 379         428 my $text = q{};
1140 379 100       664 if ( not defined $item ) {
1141 3         11 $text .= '/* empty */';
1142             }
1143             else {
1144 376         811 $text .= Marpa::PP::show_dotted_rule(
1145 376         408 @{$item}[
1146             Marpa::PP::Internal::LR0_item::RULE,
1147             Marpa::PP::Internal::LR0_item::POSITION
1148             ]
1149             );
1150             } ## end else [ if ( not defined $item ) ]
1151 379         1217 return $text;
1152             } ## end sub Marpa::PP::show_item
1153              
1154             sub Marpa::PP::show_NFA_state {
1155 81     81 0 109 my ($state) = @_;
1156 81         96 my ( $name, $item, $transition, $at_nulling, ) = @{$state}[
  81         163  
1157             Marpa::PP::Internal::NFA::NAME,
1158             Marpa::PP::Internal::NFA::ITEM,
1159             Marpa::PP::Internal::NFA::TRANSITION,
1160             Marpa::PP::Internal::NFA::AT_NULLING,
1161             ];
1162 81         138 my $text = $name . ': ';
1163 81         126 $text .= Marpa::PP::show_item($item) . "\n";
1164 81         118 my @properties = ();
1165 81 100       153 if ($at_nulling) {
1166 18         33 push @properties, 'at_nulling';
1167             }
1168 81 100       157 if (@properties) {
1169 18         34 $text .= ( join q{ }, @properties ) . "\n";
1170             }
1171              
1172 81         96 for my $symbol_name ( sort keys %{$transition} ) {
  81         244  
1173 83         122 my $transition_states = $transition->{$symbol_name};
1174 108         419 $text
1175             .= q{ }
1176             . ( $symbol_name eq q{} ? 'empty' : '<' . $symbol_name . '>' )
1177             . ' => '
1178             . join( q{ },
1179 83         138 map { $_->[Marpa::PP::Internal::NFA::NAME] }
1180 83 100       198 @{$transition_states} )
1181             . "\n";
1182             } ## end for my $symbol_name ( sort keys %{$transition} )
1183 81         255 return $text;
1184             } ## end sub Marpa::PP::show_NFA_state
1185              
1186             sub Marpa::PP::Grammar::show_NFA {
1187 4     4 0 418 my ($grammar) = @_;
1188 4         12 my $text = q{};
1189              
1190 4 100       25 return "stripped\n"
1191             if not exists $grammar->[Marpa::PP::Internal::Grammar::NFA];
1192              
1193 3         11 my $NFA = $grammar->[Marpa::PP::Internal::Grammar::NFA];
1194 3         8 for my $state ( @{$NFA} ) {
  3         10  
1195 81         146 $text .= Marpa::PP::show_NFA_state($state);
1196             }
1197              
1198 3         43 return $text;
1199             } ## end sub Marpa::PP::Grammar::show_NFA
1200              
1201             sub Marpa::PP::brief_AHFA_state {
1202 310     310 0 363 my ($state) = @_;
1203 310         958 return 'S' . $state->[Marpa::PP::Internal::AHFA::ID];
1204             }
1205              
1206             sub Marpa::PP::show_AHFA_state {
1207 145     145 0 201 my ( $state, $verbose ) = @_;
1208 145   50     557 $verbose //= 1; # legacy is to be verbose, so default to it
1209              
1210 145         181 my $text = q{};
1211 145         163 my $stripped = $#{$state} < Marpa::PP::Internal::AHFA::LAST_FIELD;
  145         258  
1212              
1213 145         289 $text .= q{* } . Marpa::PP::brief_AHFA_state($state) . q{:};
1214              
1215 145         248 my @tags = ();
1216 145 100       339 $state->[Marpa::PP::Internal::AHFA::LEO_COMPLETION]
1217             and push @tags, 'leo-c';
1218 145 100       341 $state->[Marpa::PP::Internal::AHFA::RESET_ORIGIN]
1219             and push @tags, 'predict';
1220 145 100       405 scalar @tags and $text .= q{ } . join '; ', @tags;
1221 145         192 $text .= "\n";
1222              
1223 145 50       334 if ( exists $state->[Marpa::PP::Internal::AHFA::NFA_STATES] ) {
1224 145         192 my $NFA_states = $state->[Marpa::PP::Internal::AHFA::NFA_STATES];
1225 145         180 for my $NFA_state ( @{$NFA_states} ) {
  145         270  
1226 298         428 my $item = $NFA_state->[Marpa::PP::Internal::NFA::ITEM];
1227 298         538 $text .= Marpa::PP::show_item($item) . "\n";
1228             }
1229             } ## end if ( exists $state->[Marpa::PP::Internal::AHFA::NFA_STATES...])
1230              
1231 145 50       347 if ($stripped) { $text .= "stripped\n" }
  0         0  
1232              
1233 145 50       292 return $text if not $verbose;
1234              
1235 145 100       343 if ( exists $state->[Marpa::PP::Internal::AHFA::TRANSITION] ) {
1236 81         127 my $transition = $state->[Marpa::PP::Internal::AHFA::TRANSITION];
1237 81         92 for my $symbol_name ( sort keys %{$transition} ) {
  81         300  
1238 135         247 $text .= ' <' . $symbol_name . '> => ';
1239 135         148 my @ahfa_labels;
1240 135         150 TO_STATE: for my $to_state ( @{ $transition->{$symbol_name} } ) {
  135         304  
1241 234 100       564 if ( not ref $to_state ) {
1242 69         147 push @ahfa_labels, qq{leo($to_state)};
1243 69         118 next TO_STATE;
1244             }
1245 165         283 my $to_name = $to_state->[Marpa::PP::Internal::AHFA::NAME];
1246 165         295 push @ahfa_labels, Marpa::PP::brief_AHFA_state($to_state);
1247             } # for my $to_state
1248 135         384 $text .= join '; ', sort @ahfa_labels;
1249 135         419 $text .= "\n";
1250             } ## end for my $symbol_name ( sort keys %{$transition} )
1251             } ## end if ( exists $state->[Marpa::PP::Internal::AHFA::TRANSITION...])
1252              
1253 145         486 return $text;
1254             } ## end sub Marpa::PP::show_AHFA_state
1255              
1256             sub Marpa::PP::Grammar::show_AHFA {
1257 12     12 1 2966 my ($grammar) = @_;
1258              
1259 12         34 my $text = q{};
1260 12         36 my $AHFA = $grammar->[Marpa::PP::Internal::Grammar::AHFA];
1261              
1262 12         25 for my $state ( @{$AHFA} ) {
  12         44  
1263 145         275 $text .= Marpa::PP::show_AHFA_state($state);
1264             }
1265 12         111 return $text;
1266             } ## end sub Marpa::PP::Grammar::show_AHFA
1267              
1268             # Used by lexers to check that symbol is a terminal
1269             sub Marpa::PP::Grammar::check_terminal {
1270 1     1 1 3 my ( $grammar, $name ) = @_;
1271 1 50       4 return 0 if not defined $name;
1272 1         2 my $symbol_hash = $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH];
1273 1         2 my $symbol_id = $symbol_hash->{$name};
1274 1 50       4 return 0 if not defined $symbol_id;
1275 1         2 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1276 1         2 my $symbol = $symbols->[$symbol_id];
1277 1 50       6 return 0 if not $symbol->[Marpa::PP::Internal::Symbol::TERMINAL];
1278 0         0 return 1;
1279             } ## end sub Marpa::PP::Grammar::check_terminal
1280              
1281             sub assign_symbol {
1282 2645     2645   4468 my ( $grammar, $name ) = @_;
1283              
1284 2645         5322 my $new = 0;
1285 2645         4247 my $symbol_hash = $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH];
1286 2645         5544 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1287              
1288 2645         3329 my $symbol;
1289 2645 100       11051 if ( defined( my $symbol_id = $symbol_hash->{$name} ) ) {
1290 1769         3409 $symbol = $symbols->[$symbol_id];
1291             }
1292              
1293 2645 100       7247 if ( not defined $symbol ) {
1294 876         1272 $new = 1;
1295 876         996 $#{$symbol} = Marpa::PP::Internal::Symbol::LAST_FIELD;
  876         6196  
1296 876         1978 $symbol->[Marpa::PP::Internal::Symbol::NAME] = $name;
1297 876         3956 $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] = [];
1298 876         1889 $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] = [];
1299              
1300 876         1017 my $symbol_id = @{$symbols};
  876         1506  
1301 876         1145 push @{$symbols}, $symbol;
  876         1978  
1302 876         2680 $symbol_hash->{$name} = $symbol->[Marpa::PP::Internal::Symbol::ID] =
1303             $symbol_id;
1304              
1305             } ## end if ( not defined $symbol )
1306              
1307 2645         8426 return ( $new, $symbol );
1308             } ## end sub assign_symbol
1309              
1310             sub assign_user_symbol {
1311 2504     2504   3583 my $self = shift;
1312 2504         4422 my $name = shift;
1313 2504         3838 my $options = shift;
1314              
1315 2504 50       6213 if ( my $type = ref $name ) {
1316 0         0 Marpa::PP::exception(
1317             "Symbol name was ref to $type; it must be a scalar string");
1318             }
1319 2504 50       6063 Marpa::PP::exception("Symbol name $name ends in ']': that's not allowed")
1320             if $name =~ /\]\z/xms;
1321 2504         6412 my ( $new, $symbol ) = assign_symbol( $self, $name );
1322              
1323 2504         3621 my $greed;
1324             my $ranking_action;
1325 0         0 my $terminal;
1326              
1327 2504         3228 PROPERTY: while ( my ( $property, $value ) = each %{$options} ) {
  2645         18421  
1328 141 50       1289 if ( not $property ~~ [qw(terminal ranking_action null_value)] ) {
1329 0         0 Marpa::PP::exception(qq{Unknown symbol property "$property"});
1330             }
1331 141 100       507 if ( $property eq 'terminal' ) {
1332 124         289 $symbol->[Marpa::PP::Internal::Symbol::TERMINAL] = $value;
1333             }
1334 141 100       5743 if ( $property eq 'null_value' ) {
1335 17         48 $symbol->[Marpa::PP::Internal::Symbol::NULL_VALUE] = \$value;
1336             }
1337             } ## end while ( my ( $property, $value ) = each %{$options} )
1338              
1339 2504         19862 return $symbol;
1340              
1341             } ## end sub assign_user_symbol
1342              
1343             sub add_rule {
1344              
1345 1409     1409   2474 my ($arg_hash) = @_;
1346 1409         1758 my $grammar;
1347             my $lhs;
1348 0         0 my $rhs;
1349 0         0 my $action;
1350 0         0 my $ranking_action;
1351 0         0 my $greed;
1352 0         0 my $virtual_lhs;
1353 0         0 my $virtual_rhs;
1354 0         0 my $discard_separation;
1355 0         0 my $real_symbol_count;
1356              
1357 1409         1857 while ( my ( $option, $value ) = each %{$arg_hash} ) {
  9770         33288  
1358 8361         27395 given ($option) {
1359 8361         14896 when ('grammar') { $grammar = $value }
  1409         4795  
1360 6952         13082 when ('lhs') { $lhs = $value }
  1409         4324  
1361 5543         9731 when ('rhs') { $rhs = $value }
  1409         15110  
1362 4134         5053 when ('action') { $action = $value }
  1239         3767  
1363 2895         3882 when ('ranking_action') { $ranking_action = $value }
  1239         4024  
1364 1656         2483 when ('virtual_lhs') { $virtual_lhs = $value }
  563         1650  
1365 1093         1379 when ('virtual_rhs') { $virtual_rhs = $value }
  467         2113  
1366 626         782 when ('discard_separation') { $discard_separation = $value }
  27         95  
1367 599         844 when ('real_symbol_count') { $real_symbol_count = $value }
  599         2800  
1368 0         0 default {
1369 0         0 Marpa::PP::exception("Unknown option in rule: $option");
1370             };
1371             } ## end given
1372             } ## end while ( my ( $option, $value ) = each %{$arg_hash} )
1373              
1374 1409         9385 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1375 1409         2061 my $trace_rules = $grammar->[Marpa::PP::Internal::Grammar::TRACE_RULES];
1376 1409         8907 my $trace_fh =
1377             $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE];
1378              
1379 1409         2877 my $lhs_name = $lhs->[Marpa::PP::Internal::Symbol::NAME];
1380              
1381             {
1382 1409         1863 my $rhs_length = scalar @{$rhs};
  1409         1620  
  1409         2109  
1383 1409 50       4485 if ( $rhs_length & Marpa::PP::Internal::Grammar::RHS_LENGTH_MASK ) {
1384 0         0 Marpa::PP::exception(
1385             "Rule rhs too long\n",
1386             ' Rule #',
1387 0         0 $#{$rules},
1388             " has $rhs_length symbols\n",
1389             ' Rule starts ',
1390             $lhs_name,
1391             ' -> ',
1392             ( join q{ },
1393              
1394             # Just print the first 5 symbols on the RHS
1395 0         0 map { $_->[Marpa::PP::Internal::Symbol::NAME] }
1396 0         0 @{$rhs}[ 0 .. 5 ]
1397             ),
1398             " ... \n"
1399             );
1400             } ## end if ( $rhs_length & ...)
1401             }
1402              
1403 1409         1487 my $new_rule_id = @{$rules};
  1409         1908  
1404 1409         2419 my $new_rule = [];
1405 1409         1765 $#{$new_rule} = Marpa::PP::Internal::Rule::LAST_FIELD;
  1409         5052  
1406              
1407 1409 100       3600 my $nulling = @{$rhs} ? undef : 1;
  1409         4185  
1408              
1409 1409 50 66     5384 if ( $action and $nulling ) {
1410 0         0 Marpa::PP::exception(
1411             "Empty Rule cannot have an action\n",
1412             ' Rule #',
1413 0         0 $#{$rules},
1414             ': ',
1415             $lhs->[Marpa::PP::Internal::Symbol::NAME],
1416             ' -> /* empty */',
1417             "\n"
1418             );
1419             } ## end if ( $action and $nulling )
1420              
1421 1409         2434 $new_rule->[Marpa::PP::Internal::Rule::ID] = $new_rule_id;
1422 1409         2310 $new_rule->[Marpa::PP::Internal::Rule::LHS] = $lhs;
1423 1409         2301 $new_rule->[Marpa::PP::Internal::Rule::RHS] = $rhs;
1424 1409         2354 $new_rule->[Marpa::PP::Internal::Rule::ACTION] = $action;
1425 1409         2409 $new_rule->[Marpa::PP::Internal::Rule::RANKING_ACTION] = $ranking_action;
1426 1409         2125 $new_rule->[Marpa::PP::Internal::Rule::VIRTUAL_LHS] = $virtual_lhs;
1427 1409         2305 $new_rule->[Marpa::PP::Internal::Rule::VIRTUAL_RHS] = $virtual_rhs;
1428 1409         1793 $new_rule->[Marpa::PP::Internal::Rule::DISCARD_SEPARATION] =
1429             $discard_separation;
1430 1409         1970 $new_rule->[Marpa::PP::Internal::Rule::REAL_SYMBOL_COUNT] =
1431             $real_symbol_count;
1432 1409         2448 $new_rule->[Marpa::PP::Internal::Rule::USED] = 1;
1433              
1434 1409         1546 push @{$rules}, $new_rule;
  1409         2830  
1435             {
1436 1409         1792 my $lhs_rule_ids = $lhs->[Marpa::PP::Internal::Symbol::LH_RULE_IDS];
  1409         2041  
1437 1409         1581 push @{$lhs_rule_ids}, $new_rule_id;
  1409         5033  
1438             }
1439              
1440 1409         1880 SYMBOL: for my $symbol ( @{$rhs} ) {
  1409         3060  
1441 3314         4367 my $rhs_rule_ids =
1442             $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS];
1443 3314 100       3869 next SYMBOL if $new_rule_id ~~ @{$rhs_rule_ids};
  3314         14068  
1444 3088         4155 push @{$rhs_rule_ids}, $new_rule_id;
  3088         8678  
1445             } ## end for my $symbol ( @{$rhs} )
1446              
1447 1409 50       4339 if ($trace_rules) {
1448 0         0 print {$trace_fh} 'Added rule #', $#{$rules}, ': ',
  0         0  
  0         0  
1449             $lhs->[Marpa::PP::Internal::Symbol::NAME], ' -> ',
1450             join( q{ },
1451 0 0       0 map { $_->[Marpa::PP::Internal::Symbol::NAME] } @{$rhs} ),
  0         0  
1452             "\n"
1453             or Marpa::PP::exception("Could not print: $ERRNO");
1454             } ## end if ($trace_rules)
1455 1409         5127 return $new_rule;
1456             } ## end sub add_rule
1457              
1458             # add one or more rules
1459             sub add_user_rules {
1460 82     82   234 my ( $grammar, $rules ) = @_;
1461              
1462 82         160 RULE: for my $rule ( @{$rules} ) {
  82         534  
1463              
1464 800         1821 given ( ref $rule ) {
1465 800         1454 when ('ARRAY') {
1466 201         1727 my $arg_count = @{$rule};
  201         414  
1467              
1468 201 50 33     1192 if ( $arg_count > 4 or $arg_count < 1 ) {
1469 0 0       0 Marpa::PP::exception(
1470             "Rule has $arg_count arguments: "
1471             . join( ', ',
1472 0         0 map { defined $_ ? $_ : 'undef' } @{$rule} )
  0         0  
1473             . "\n"
1474             . 'Rule must have from 1 to 4 arguments'
1475             );
1476             } ## end if ( $arg_count > 4 or $arg_count < 1 )
1477 201         244 my ( $lhs, $rhs, $action, ) = @{$rule};
  201         438  
1478 201         1955 add_user_rule(
1479             $grammar,
1480             { lhs => $lhs,
1481             rhs => $rhs,
1482             action => $action,
1483             }
1484             );
1485              
1486             } ## end when ('ARRAY')
1487 599         1581 when ('HASH') {
1488 599         1681 add_user_rule( $grammar, $rule );
1489             }
1490 0         0 default {
1491 0         0 Marpa::PP::exception(
1492             'Invalid rule: ',
1493             Data::Dumper->new( [$rule], ['Invalid_Rule'] )->Indent(2)
1494             ->Terse(1)->Maxdepth(2)->Dump,
1495             'Rule must be ref to HASH or ARRAY'
1496             );
1497             } ## end default
1498             } ## end given
1499              
1500             } # RULE
1501              
1502 81         224 return;
1503              
1504             } ## end sub add_user_rules
1505              
1506             sub add_user_rule {
1507 800     800   1307 my ( $grammar, $options ) = @_;
1508              
1509 800 50 33     3559 Marpa::PP::exception('Missing argument to add_user_rule')
1510             if not defined $grammar
1511             or not defined $options;
1512              
1513 800         940 my ( $lhs_name, $rhs_names, $action );
1514 0         0 my ( $min, $separator_name );
1515 0         0 my $ranking_action;
1516 800         1011 my $proper_separation = 0;
1517 800         891 my $keep_separation = 0;
1518              
1519 800         1193 while ( my ( $option, $value ) = each %{$options} ) {
  2926         10430  
1520 2126         3137 given ($option) {
1521 2126         3391 when ('rhs') { $rhs_names = $value }
  796         2644  
1522 1330         1951 when ('lhs') { $lhs_name = $value }
  800         2323  
1523 530         1027 when ('action') { $action = $value }
  461         1180  
1524 69         105 when ('ranking_action') { $ranking_action = $value }
  6         18  
1525 63         97 when ('min') { $min = $value }
  27         80  
1526 36         66 when ('separator') { $separator_name = $value }
  15         52  
1527 21         125 when ('proper') { $proper_separation = $value }
  6         17  
1528 15         39 when ('keep') { $keep_separation = $value }
  15         42  
1529 0         0 default {
1530 0         0 Marpa::PP::exception("Unknown user rule option: $option");
1531             };
1532             } ## end given
1533             } ## end while ( my ( $option, $value ) = each %{$options} )
1534              
1535 800         2914 my $rule_signature_hash =
1536             $grammar->[Marpa::PP::Internal::Grammar::RULE_SIGNATURE_HASH];
1537              
1538 800         1887 my $lhs = assign_user_symbol( $grammar, $lhs_name );
1539 800   100     3246 $rhs_names //= [];
1540 800         1611 CHECK_RULE: {
1541 800         1426 my @problems = ();
1542 800         1480 my $rhs_ref_type = ref $rhs_names;
1543 800 50 33     4432 if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' ) {
1544 0 0       0 push @problems,
1545             "RHS is not ref to ARRAY\n"
1546             . 'rhs is '
1547             . ( $rhs_ref_type ? $rhs_ref_type : 'not a ref' );
1548             } ## end if ( not $rhs_ref_type or $rhs_ref_type ne 'ARRAY' )
1549 800 50       1677 if ( not defined $lhs_name ) {
1550 0         0 push @problems, "Missing LHS\n";
1551             }
1552 800 50       2269 last CHECK_RULE if not scalar @problems;
1553 0         0 my %dump_options = %{$options};
  0         0  
1554 0         0 delete $dump_options{grammar};
1555 0         0 my $msg =
1556             ( scalar @problems ) . " problem(s) in the following rule:\n";
1557 0         0 my $d = Data::Dumper->new( [ \%dump_options ], ['rule'] );
1558 0         0 $msg .= $d->Dump();
1559 0         0 for my $problem_number ( 0 .. $#problems ) {
1560 0         0 $msg
1561             .= 'Problem '
1562             . ( $problem_number + 1 ) . q{: }
1563             . $problems[$problem_number] . "\n";
1564             } ## end for my $problem_number ( 0 .. $#problems )
1565 0         0 Marpa::PP::exception($msg);
1566             } ## end CHECK_RULE:
1567              
1568 800         2285 my $rhs = [ map { assign_user_symbol( $grammar, $_ ); } @{$rhs_names} ];
  1551         3378  
  800         1596  
1569              
1570             # Don't allow the user to duplicate a rule
1571 2351         7090 my $rule_signature = join q{,},
1572 800         1698 map { $_->[Marpa::PP::Internal::Symbol::ID] } ( $lhs, @{$rhs} );
  800         1928  
1573 1         353 Marpa::PP::exception( 'Duplicate rule: ',
1574 800 100       3732 $lhs_name, ' -> ', ( join q{ }, @{$rhs_names} ) )
1575             if exists $rule_signature_hash->{$rule_signature};
1576              
1577 799         2640 $rule_signature_hash->{$rule_signature} = 1;
1578              
1579 799 100 100     1500 if ( scalar @{$rhs_names} == 0 or not defined $min ) {
  799         4762  
1580              
1581 772 50       1660 if ( defined $separator_name ) {
1582 0         0 Marpa::PP::exception(
1583             'separator defined for rule without repetitions');
1584             }
1585              
1586             # This is an ordinary, non-counted rule,
1587             # which we'll take care of first as a special case
1588 772         6154 my $ordinary_rule = add_rule(
1589             { grammar => $grammar,
1590             lhs => $lhs,
1591             rhs => $rhs,
1592             action => $action,
1593             ranking_action => $ranking_action,
1594             }
1595             );
1596              
1597 772         4992 return;
1598              
1599             } # not defined $min
1600              
1601             # The original rule for a sequence rule --
1602             # not actually used.
1603 27   100     490 my $original_rule = add_rule(
1604             { grammar => $grammar,
1605             lhs => $lhs,
1606             rhs => $rhs,
1607             action => $action,
1608             ranking_action => $ranking_action,
1609             discard_separation =>
1610             ( not $keep_separation and defined $separator_name ),
1611             }
1612             );
1613 27         123 $original_rule->[Marpa::PP::Internal::Rule::USED] = 0;
1614              
1615             # At this point we know that min must be 0 or 1
1616             # and that there is at least one symbol on the rhs
1617              
1618             # nulling rule is special case
1619 27 100       111 if ( $min == 0 ) {
1620 11         45 my @rule_args = (
1621             grammar => $grammar,
1622             lhs => $lhs,
1623             rhs => [],
1624             );
1625              
1626             # For a zero-length sequence
1627             # with an action
1628             # warn if we don't also have a null value.
1629              
1630 11 100       38 if ($action) {
1631 1         5 $lhs->[Marpa::PP::Internal::Symbol::WARN_IF_NO_NULL_VALUE] = 1;
1632             }
1633              
1634 11 50       32 if ($ranking_action) {
1635 0         0 push @rule_args, ranking_action => $ranking_action;
1636             }
1637 11         50 add_rule( {@rule_args} );
1638 11         38 $min = 1;
1639             } ## end if ( $min == 0 )
1640              
1641 27         97 Marpa::PP::exception('Only one rhs symbol allowed for counted rule')
1642 27 50       49 if scalar @{$rhs_names} != 1;
1643              
1644 27         54 my $sequence_item = $rhs->[0];
1645 27         54 $sequence_item->[Marpa::PP::Internal::Symbol::COUNTED] = 1;
1646              
1647             # create the separator symbol, if we're using one
1648 27         43 my $separator;
1649 27 100       91 if ( defined $separator_name ) {
1650 15         48 $separator = assign_user_symbol( $grammar, $separator_name );
1651 15         34 $separator->[Marpa::PP::Internal::Symbol::COUNTED] = 1;
1652             }
1653              
1654             # create the sequence symbol
1655 27         138 my $sequence_name =
1656             $lhs_name
1657             . '[Subseq:'
1658             . $lhs->[Marpa::PP::Internal::Symbol::ID] . q{:}
1659             . $rhs->[0]->[Marpa::PP::Internal::Symbol::ID] . ']';
1660 27         76 my $sequence = assign_symbol( $grammar, $sequence_name );
1661              
1662             # The top sequence rule
1663 27         247 my $top_rule = add_rule(
1664             { grammar => $grammar,
1665             lhs => $lhs,
1666             rhs => [$sequence],
1667             virtual_rhs => 1,
1668             real_symbol_count => 0,
1669             action => $action,
1670             ranking_action => $ranking_action,
1671             }
1672             );
1673 27         117 $top_rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE] = $original_rule;
1674              
1675             # An alternative top sequence rule needed for perl5 separation
1676 27 100 100     178 if ( defined $separator and not $proper_separation ) {
1677 9         78 my $alt_top_rule = add_rule(
1678             { grammar => $grammar,
1679             lhs => $lhs,
1680             rhs => [ $sequence, $separator, ],
1681             virtual_rhs => 1,
1682             real_symbol_count => 1,
1683             action => $action,
1684             ranking_action => $ranking_action,
1685             }
1686             );
1687 9         39 $alt_top_rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE] =
1688             $original_rule;
1689             } ## end if ( defined $separator and not $proper_separation )
1690              
1691 27 100       111 my @separated_rhs =
1692             defined $separator
1693             ? ( $separator, $sequence_item )
1694             : ($sequence_item);
1695              
1696 27         131 my $counted_rhs = [ $sequence_item, (@separated_rhs) x ( $min - 1 ) ];
1697              
1698             # Minimal sequence rule
1699 27         175 add_rule(
1700             { grammar => $grammar,
1701             lhs => $sequence,
1702             rhs => $counted_rhs,
1703             virtual_lhs => 1,
1704 27         56 real_symbol_count => ( scalar @{$counted_rhs} ),
1705             }
1706             );
1707              
1708             # iterating sequence rule
1709 27         120 my @iterating_rhs = ( $sequence, @separated_rhs );
1710 27         183 add_rule(
1711             { grammar => $grammar,
1712             lhs => $sequence,
1713             rhs => \@iterating_rhs,
1714             virtual_lhs => 1,
1715             virtual_rhs => 1,
1716             real_symbol_count => ( scalar @separated_rhs ),
1717             }
1718             );
1719              
1720 27         193 return;
1721              
1722             } ## end sub add_user_rule
1723              
1724             sub check_start {
1725 79     79   207 my $grammar = shift;
1726 79         151 my $success = 1;
1727              
1728 79         198 my $start_name = $grammar->[Marpa::PP::Internal::Grammar::START_NAME];
1729 79 100       703 Marpa::PP::exception('No start symbol specified')
1730             if not defined $start_name;
1731 78 50       317 if ( my $ref_type = ref $start_name ) {
1732 0         0 Marpa::PP::exception(
1733             "Start symbol name specified as a ref to $ref_type, it should be a string"
1734             );
1735             }
1736              
1737 78         201 my $symbol_hash = $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH];
1738 78         156 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1739 78         203 my $start_id = $symbol_hash->{$start_name};
1740              
1741 78 50       281 Marpa::PP::exception(qq{Start symbol "$start_name" not in grammar})
1742             if not defined $start_id;
1743              
1744 78         567 my $start = $symbols->[$start_id];
1745 78 50       315 Marpa::PP::exception(
1746             qq{Internal error: Start symbol "$start_name" id not found})
1747             if not $start;
1748              
1749 78         188 my $lh_rule_ids = $start->[Marpa::PP::Internal::Symbol::LH_RULE_IDS];
1750 78         176 my $terminal = $start->[Marpa::PP::Internal::Symbol::TERMINAL];
1751              
1752 78 100       308 if ( not $start->[Marpa::PP::Internal::Symbol::PRODUCTIVE] ) {
1753 1         3 my $problem = qq{Unproductive start symbol: "$start_name"};
1754 1         389 Marpa::PP::exception($problem);
1755             }
1756              
1757 77 100       158 if ( not scalar @{$lh_rule_ids} ) {
  77         325  
1758 1         4 my $problem = qq{Start symbol "$start_name" not on LHS of any rule};
1759 1         351 Marpa::PP::exception($problem);
1760             }
1761              
1762 76         224 $grammar->[Marpa::PP::Internal::Grammar::START] = $start;
1763              
1764 76         590 return $success;
1765             } ## end sub check_start
1766              
1767             # return list of rules reachable from the start symbol;
1768             sub accessible {
1769 76     76   148 my $grammar = shift;
1770 76         158 my $start = $grammar->[Marpa::PP::Internal::Grammar::START];
1771 76         153 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1772              
1773 76         200 $start->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = 1;
1774 76         219 my $symbol_work_set = [$start];
1775 76         141 my $rule_work_set = [];
1776              
1777 76         138 my $work_to_do = 1;
1778              
1779 76         401 while ($work_to_do) {
1780 328         415 $work_to_do = 0;
1781              
1782 328         411 SYMBOL_PASS: while ( my $work_symbol = shift @{$symbol_work_set} ) {
  1065         2561  
1783 737         962 my $produced_rule_ids =
1784             $work_symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS];
1785 737         756 PRODUCED_RULE: for my $rule_id ( @{$produced_rule_ids} ) {
  737         1458  
1786              
1787 873         1160 my $rule = $rules->[$rule_id];
1788             next PRODUCED_RULE
1789 873 50       1742 if defined $rule->[Marpa::PP::Internal::Rule::ACCESSIBLE];
1790              
1791 873         1167 $rule->[Marpa::PP::Internal::Rule::ACCESSIBLE] = 1;
1792 873         827 $work_to_do++;
1793 873         835 push @{$rule_work_set}, $rule;
  873         2175  
1794              
1795             } ## end for my $rule_id ( @{$produced_rule_ids} )
1796             } # SYMBOL_PASS
1797              
1798 328         457 RULE: while ( my $work_rule = shift @{$rule_work_set} ) {
  1201         4339  
1799 873         1160 my $rhs_symbol = $work_rule->[Marpa::PP::Internal::Rule::RHS];
1800              
1801 873         906 RHS: for my $symbol ( @{$rhs_symbol} ) {
  873         2159  
1802              
1803             next RHS
1804             if defined
1805 1682 100       4056 $symbol->[Marpa::PP::Internal::Symbol::ACCESSIBLE];
1806 661         880 $symbol->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = 1;
1807 661         679 $work_to_do++;
1808              
1809 661         865 push @{$symbol_work_set}, $symbol;
  661         3231  
1810             } ## end for my $symbol ( @{$rhs_symbol} )
1811              
1812             } # RULE
1813              
1814             } # work_to_do loop
1815              
1816 76         221 return 1;
1817              
1818             } ## end sub accessible
1819              
1820             sub productive {
1821 79     79   258 my ($grammar) = @_;
1822              
1823 79         202 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1824 79         170 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1825              
1826             # All nullable and terminal symbols are productive.
1827 79         158 for my $symbol ( @{$symbols} ) {
  79         239  
1828 750   100     2557 $symbol->[Marpa::PP::Internal::Symbol::PRODUCTIVE] =
1829             $symbol->[Marpa::PP::Internal::Symbol::TERMINAL]
1830             || $symbol->[Marpa::PP::Internal::Symbol::NULLABLE];
1831             }
1832              
1833 79         187 my @workset;
1834 750         1324 my @potential_productive_symbol_ids =
1835 79         174 ( map { $_->[Marpa::PP::Internal::Symbol::ID] } @{$symbols} );
  79         201  
1836 79         495 @workset[@potential_productive_symbol_ids] =
1837             (1) x scalar @potential_productive_symbol_ids;
1838              
1839 79         1246 while ( my @symbol_ids = grep { $workset[$_] } ( 0 .. $#{$symbols} ) ) {
  4527         12340  
  212         636  
1840 133         357 @workset = ();
1841 133         248 SYMBOL: for my $symbol ( map { $symbols->[$_] } @symbol_ids ) {
  917         1370  
1842              
1843             # Look for the first rule with no unproductive symbols
1844             # on the RHS. (It could be an empty rule.)
1845             # If there is one, this is a productive symbol.
1846             # If there is none, we have not yet shown this
1847             # symbol to be productive.
1848             next SYMBOL if not defined List::Util::first {
1849             not defined List::Util::first {
1850 1202         3133 not $_->[Marpa::PP::Internal::Symbol::PRODUCTIVE];
1851             }
1852 777     777   2127 @{ $rules->[$_]->[Marpa::PP::Internal::Rule::RHS] };
  777         2471  
1853             } ## end List::Util::first
1854 917 100       3941 @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
  917         4078  
1855              
1856 461         2283 $symbol->[Marpa::PP::Internal::Symbol::PRODUCTIVE] = 1;
1857 351         639 my @potential_new_productive_symbol_ids =
1858 999         1956 map { $_->[Marpa::PP::Internal::Symbol::ID] }
1859 999         1903 grep { not $_->[Marpa::PP::Internal::Symbol::PRODUCTIVE] }
1860 461         3446 map { $rules->[$_]->[Marpa::PP::Internal::Rule::LHS] }
1861 461         639 @{ $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] };
1862 461         1897 @workset[@potential_new_productive_symbol_ids] =
1863             (1) x scalar @potential_new_productive_symbol_ids;
1864             } ## end for my $symbol ( map { $symbols->[$_] } @symbol_ids )
1865             } ## end while ( my @symbol_ids = grep { $workset[$_] } ( 0 .. $#...))
1866              
1867             # Now that we know productivity for all the symbols,
1868             # determine it for the rules.
1869             # If the are no unproductive symbols on the RHS of
1870             # a rule, then the rule is productive.
1871             # The double negative catches the vacuous case:
1872             # A rule with an empty RHS is productive.
1873 79         205 RULE: for my $rule ( @{$rules} ) {
  79         790  
1874             next RULE
1875             if defined List::Util::first {
1876 1694     1694   3061 not $_->[Marpa::PP::Internal::Symbol::PRODUCTIVE];
1877             }
1878 884 100       2212 @{ $rule->[Marpa::PP::Internal::Rule::RHS] };
  884         2569  
1879 881         2643 $rule->[Marpa::PP::Internal::Rule::PRODUCTIVE]++;
1880             } ## end for my $rule ( @{$rules} )
1881              
1882 79         311 return 1;
1883              
1884             } ## end sub productive
1885              
1886             sub has_empty_rule {
1887 14     14   36 my ($grammar) = @_;
1888 14         32 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1889 14         27 RULE: for my $rule ( @{$rules} ) {
  14         37  
1890 64 50       74 next RULE if scalar @{ $rule->[Marpa::PP::Internal::Rule::RHS] };
  64         210  
1891 0         0 Marpa::PP::exception(
1892             'A grammar with empty rules must mark its terminals or unset lhs_terminals'
1893             );
1894             } ## end for my $rule ( @{$rules} )
1895 14         60 return;
1896             } ## end sub has_empty_rule
1897              
1898             sub terminals_distinguished {
1899 81     81   208 my ($grammar) = @_;
1900 81         171 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1901 81         156 for my $symbol ( @{$symbols} ) {
  81         214  
1902 524 100       1331 return 1 if $symbol->[Marpa::PP::Internal::Symbol::TERMINAL];
1903             }
1904 20         64 return 0;
1905             } ## end sub terminals_distinguished
1906              
1907             sub mark_all_symbols_terminal {
1908 14     14   29 my ($grammar) = @_;
1909 14         31 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1910 14         26 for my $symbol ( @{$symbols} ) {
  14         34  
1911 71         129 $symbol->[Marpa::PP::Internal::Symbol::TERMINAL] = 1;
1912             }
1913 14         41 return 1;
1914             } ## end sub mark_all_symbols_terminal
1915              
1916             sub check_lhs_non_terminal {
1917 1     1   2 my ($grammar) = @_;
1918 1         1 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1919 1         2 SYMBOL: for my $symbol ( @{$symbols} ) {
  1         3  
1920 1 50       3 next SYMBOL if not $symbol->[Marpa::PP::Internal::Symbol::TERMINAL];
1921             next SYMBOL
1922             if not
1923 1 50       2 scalar @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS]
  1         3  
1924             };
1925 1         3 my $name = $symbol->[Marpa::PP::Internal::Symbol::NAME];
1926 1         301 Marpa::PP::exception(
1927             "lhs_terminals option is off, but Symbol $name is both an LHS and a terminal"
1928             );
1929             } ## end for my $symbol ( @{$symbols} )
1930 0         0 return 1;
1931             } ## end sub check_lhs_non_terminal
1932              
1933             sub mark_non_lhs_terminal {
1934 6     6   17 my ($grammar) = @_;
1935 6         17 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
1936 6         15 SYMBOL: for my $symbol ( @{$symbols} ) {
  6         25  
1937             next SYMBOL
1938             if
1939 353 100       297 scalar @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
  353         737  
1940 185         265 $symbol->[Marpa::PP::Internal::Symbol::TERMINAL] = 1;
1941             } ## end for my $symbol ( @{$symbols} )
1942 6         17 return 1;
1943             } ## end sub mark_non_lhs_terminal
1944              
1945             # Assumes that, at the point when nulling() is called,
1946             # no symbol already has NULLING set. The loop control
1947             # logic relies on this.
1948             sub nulling {
1949 80     80   202 my $grammar = shift;
1950              
1951 80         214 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
1952              
1953 107         308 my @worklist =
1954 892         2008 map { $_->[Marpa::PP::Internal::Rule::LHS] }
1955 892         858 grep { not scalar @{ $_->[Marpa::PP::Internal::Rule::RHS] } }
  80         186  
1956 80         248 @{$rules};
1957              
1958 80         496 SYMBOL: while ( my $symbol = pop @worklist ) {
1959              
1960             # this one we've already done
1961 155 50       392 next SYMBOL if $symbol->[Marpa::PP::Internal::Symbol::NULLING];
1962              
1963             # terminals are never nulling
1964 155 100       842 next SYMBOL if $symbol->[Marpa::PP::Internal::Symbol::TERMINAL];
1965              
1966 147         583 for my $lh_rule_id (
  147         304  
1967             @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] } )
1968             {
1969 181         216 for my $rh_symbol (
  181         855  
1970             @{ $rules->[$lh_rule_id]->[Marpa::PP::Internal::Rule::RHS] } )
1971             {
1972             next SYMBOL
1973 128 100       638 if not $rh_symbol->[Marpa::PP::Internal::Symbol::NULLING];
1974             } ## end for my $rh_symbol ( @{ $rules->[$lh_rule_id]->[...]})
1975             } ## end for my $lh_rule_id ( @{ $symbol->[...]})
1976              
1977 35         103 $symbol->[Marpa::PP::Internal::Symbol::NULLING] = 1;
1978 35         65 for my $rh_rule_id (
  35         92  
1979             @{ $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] } )
1980             {
1981 48         1003 push @worklist,
1982             $rules->[$rh_rule_id]->[Marpa::PP::Internal::Rule::LHS];
1983              
1984             } ## end for my $rh_rule_id ( @{ $symbol->[...]})
1985              
1986             } ## end while ( my $symbol = pop @worklist )
1987              
1988 80         179 return 1;
1989              
1990             } ## end sub nulling
1991              
1992             # Assumes that nulling symbols have been marked, but
1993             # that no symbol has been marked nullable -- the loop control
1994             # logic requires this.
1995             #
1996             # Returns undef if there was a problem
1997             #
1998             sub nullable {
1999 80     80   171 my ($grammar) = @_;
2000 80         196 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
2001 80         179 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
2002              
2003 107         264 my @worklist =
2004 892         1901 map { $_->[Marpa::PP::Internal::Rule::LHS] }
2005 892         1020 grep { not scalar @{ $_->[Marpa::PP::Internal::Rule::RHS] } }
  80         201  
2006 80         164 @{$rules};
2007              
2008 80         591 SYMBOL: while ( my $symbol = pop @worklist ) {
2009              
2010             # this one we've already done
2011 314 100       835 next SYMBOL if $symbol->[Marpa::PP::Internal::Symbol::NULLABLE];
2012              
2013             # terminals can be nullable if they are also LHS symbols
2014              
2015             # Assume it is not nullable and look for a nullable rule
2016             # with this symbol on the LHS
2017 287         364 my $nullable = 0;
2018 287         547 RULE:
2019 287         373 for my $lh_rule_id (
2020             @{ $symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] } )
2021             {
2022 1092         1293 for my $rh_symbol (
  1092         2013  
2023             @{ $rules->[$lh_rule_id]->[Marpa::PP::Internal::Rule::RHS] } )
2024             {
2025             next RULE
2026             if
2027 1364 100       3464 not $rh_symbol->[Marpa::PP::Internal::Symbol::NULLABLE];
2028             } ## end for my $rh_symbol ( @{ $rules->[$lh_rule_id]->[...]})
2029              
2030             # No non-nullable symbol found, so the rule and therefore its
2031             # LHS symbol are nullable
2032 149         237 $nullable = 1;
2033 149         499 last RULE;
2034              
2035             } ## end for my $lh_rule_id ( @{ $symbol->[...]})
2036              
2037 287 100       1010 next SYMBOL if not $nullable;
2038              
2039 149         308 $symbol->[Marpa::PP::Internal::Symbol::NULLABLE] = 1;
2040 149         201 for my $rh_rule_id (
  149         348  
2041             @{ $symbol->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] } )
2042             {
2043 207         911 push @worklist,
2044             $rules->[$rh_rule_id]->[Marpa::PP::Internal::Rule::LHS];
2045              
2046             } ## end for my $rh_rule_id ( @{ $symbol->[...]})
2047              
2048             } ## end while ( my $symbol = pop @worklist )
2049              
2050 80         159 my $counted_nullable_count;
2051 80         167 for my $symbol ( @{$symbols} ) {
  80         199  
2052 755         832 my ( $name, $nullable, $counted, ) = @{$symbol}[
  755         1470  
2053             Marpa::PP::Internal::Symbol::NAME,
2054             Marpa::PP::Internal::Symbol::NULLABLE,
2055             Marpa::PP::Internal::Symbol::COUNTED,
2056             ];
2057 755 100 100     2952 if ( $nullable and $counted ) {
2058 1         4 my $problem =
2059             qq{Nullable symbol "$name" is on rhs of counted rule};
2060 1         1 push @{ $grammar->[Marpa::PP::Internal::Grammar::PROBLEMS] },
  1         2  
2061             $problem;
2062 1         3 $counted_nullable_count++;
2063             } ## end if ( $nullable and $counted )
2064             } ## end for my $symbol ( @{$symbols} )
2065 80 100       355 if ($counted_nullable_count) {
2066 1         6 Marpa::PP::exception( Marpa::PP::Grammar::show_problems($grammar),
2067             'Counted nullables confuse Marpa -- please rewrite the grammar' );
2068             }
2069              
2070 79         634 return 1;
2071              
2072             } ## end sub nullable
2073              
2074             # This assumes the CHAF rewrite has been done,
2075             # so that every symbol is either nulling or
2076             # non-nullable. There are no proper nullables.
2077             sub infinite_rules {
2078 76     76   167 my ($grammar) = @_;
2079 76         173 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
2080 76         174 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
2081              
2082 76         181 my @unit_derivation; # for the unit derivation matrix
2083             my @new_unit_derivations; # a list of new unit derivations
2084 0         0 my @unit_rules; # a list of the unit rules
2085              
2086             # initialize the unit derivations from the rules
2087 76         155 RULE: for my $rule ( @{$rules} ) {
  76         198  
2088 1387 100       7401 next RULE if not $rule->[Marpa::PP::Internal::Rule::USED];
2089 1120         3668 my $rhs = $rule->[Marpa::PP::Internal::Rule::RHS];
2090 1120         1749 my $non_nulling_symbol;
2091              
2092             # Looking for unit rules:
2093             # Eliminate all rules with two or more non-nullables on
2094             # the RHS.
2095 1120         1648 for my $rhs_symbol ( @{$rhs} ) {
  1120         2372  
2096 1943 100       6463 if ( not $rhs_symbol->[Marpa::PP::Internal::Symbol::NULLABLE] ) {
2097              
2098             # if we have two non-nullables on the RHS in this rule,
2099             # it cannot be a unit rule and we can ignore it
2100 1631 100       4786 next RULE if defined $non_nulling_symbol;
2101              
2102 1090         3159 $non_nulling_symbol = $rhs_symbol;
2103             } ## end if ( not $rhs_symbol->[...])
2104             } # for $rhs_symbol
2105              
2106             # Above we've eliminated all rules with two or more non-nulling
2107             # on the RHS. So here we have a rule with zero or one non-nulling
2108             # symbol on the RHS. With zero non-nulling rules, this rule
2109             # must be nulling (empty) and cannot cycle.
2110             # Only one empty rule is allowed in a CHAF grammar -- a nulling
2111             # start rule -- this takes care of that exception.
2112 579 100       1898 next RULE if not defined $non_nulling_symbol;
2113              
2114 549         907 my $start_id =
2115             $rule->[Marpa::PP::Internal::Rule::LHS]
2116             ->[Marpa::PP::Internal::Symbol::ID];
2117 549         1022 my $derived_id =
2118             $non_nulling_symbol->[Marpa::PP::Internal::Symbol::ID];
2119              
2120             # Keep track of our unit rules
2121 549         1449 push @unit_rules, [ $rule, $start_id, $derived_id ];
2122              
2123 549         1736 $unit_derivation[$start_id][$derived_id] = 1;
2124 549         2199 push @new_unit_derivations, [ $start_id, $derived_id ];
2125              
2126             } ## end for my $rule ( @{$rules} )
2127              
2128             # Now find the transitive closure of the unit derivation matrix
2129             CLOSURE_LOOP:
2130 76         377 while ( my $new_unit_derivation = shift @new_unit_derivations ) {
2131              
2132 3339         3953 my ( $start_id, $derived_id ) = @{$new_unit_derivation};
  3339         6418  
2133 3339         4696 ID: for my $id ( 0 .. $#{$symbols} ) {
  3339         8196  
2134              
2135             # does the derived symbol derive this id?
2136             # if not, no new derivation, and continue looping
2137 467628 100       1213504 next ID if not $unit_derivation[$derived_id][$id];
2138              
2139             # also, if we've already recorded this unit derivation,
2140             # skip it
2141 18472 100       53001 next ID if $unit_derivation[$start_id][$id];
2142              
2143 2790         6651 $unit_derivation[$start_id][$id] = 1;
2144 2790         7781 push @new_unit_derivations, [ $start_id, $id ];
2145             } ## end for my $id ( 0 .. $#{$symbols} )
2146              
2147             } ## end while ( my $new_unit_derivation = shift @new_unit_derivations)
2148              
2149 76         223 my @infinite_rules = ();
2150              
2151             # produce a list of the rules which cycle
2152 76         368 RULE: while ( my $unit_rule_data = pop @unit_rules ) {
2153              
2154 549         991 my ( $rule, $start_symbol_id, $derived_symbol_id ) =
2155 549         616 @{$unit_rule_data};
2156              
2157             next RULE
2158 549 100 100     4844 if $start_symbol_id != $derived_symbol_id
2159             and
2160             not $unit_derivation[$derived_symbol_id][$start_symbol_id];
2161              
2162 18         33 push @infinite_rules, $rule;
2163              
2164 18         35 $rule->[Marpa::PP::Internal::Rule::CYCLE] = 1;
2165              
2166             # From a virtual point of view, a rule is a cycle if it is
2167             # not a CHAF rule, or if it does not have a virtual RHS.
2168             # Rules from a sequence rule rewrite count as "virtual"
2169             # rules for this purpose, at least for now.
2170 18   100     119 $rule->[Marpa::PP::Internal::Rule::VIRTUAL_CYCLE] =
2171             !( defined $rule->[Marpa::PP::Internal::Rule::VIRTUAL_START] )
2172             || !$rule->[Marpa::PP::Internal::Rule::VIRTUAL_RHS];
2173             } ## end while ( my $unit_rule_data = pop @unit_rules )
2174              
2175 76         890 $grammar->[Marpa::PP::Internal::Grammar::HAS_CYCLE] =
2176             scalar @infinite_rules;
2177              
2178 76         1047 return \@infinite_rules;
2179              
2180             } ## end sub infinite_rules
2181              
2182             # This assumes the grammar has been rewritten into CHAF form.
2183             sub detect_infinite {
2184 76     76   199 my $grammar = shift;
2185 76         453 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
2186 76         331 my $trace_fh =
2187             $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE];
2188              
2189 76         163 my $infinite_is_fatal = 1;
2190 76         133 my $warn_on_infinite = 1;
2191 76         197 given ( $grammar->[Marpa::PP::Internal::Grammar::INFINITE_ACTION] ) {
2192 76         184 when ('warn') { $infinite_is_fatal = 0; }
  5         12  
2193 71         197 when ('quiet') {
2194 2         13 $infinite_is_fatal = 0;
2195 2         4 $warn_on_infinite = 0;
2196             }
2197             } ## end given
2198              
2199 76         7584 my $infinite_rules = infinite_rules($grammar);
2200              
2201             # produce a list of the rules which cycle
2202 76         468 RULE: for my $rule ( reverse @{$infinite_rules} ) {
  76         365  
2203              
2204 18   66     71 my $warning_rule = $rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE]
2205             // $rule;
2206              
2207 18 100 66     85 if ( $warn_on_infinite and defined $warning_rule ) {
2208 12 50       17 print {$trace_fh}
  12         57  
2209             'Cycle found involving rule: ',
2210             Marpa::PP::brief_rule($warning_rule), "\n"
2211             or Marpa::PP::exception("Could not print: $ERRNO");
2212             } ## end if ( $warn_on_infinite and defined $warning_rule )
2213             } ## end for my $rule ( reverse @{$infinite_rules} )
2214              
2215 76 100       143 if ( scalar @{$infinite_rules} ) {
  76         335  
2216 7 50       22 Marpa::PP::exception('Cycle in grammar, fatal error')
2217             if $infinite_is_fatal;
2218             }
2219              
2220 76         228 return 1;
2221              
2222             } # sub detect_infinite
2223              
2224             sub create_NFA {
2225 76     76   171 my $grammar = shift;
2226 76         286 my ( $rules, $symbols, $start ) = @{$grammar}[
  76         222  
2227             Marpa::PP::Internal::Grammar::RULES,
2228             Marpa::PP::Internal::Grammar::SYMBOLS,
2229             Marpa::PP::Internal::Grammar::START,
2230             ];
2231              
2232             # start rules are rules with the start symbol
2233             # or with the start alias on the LHS.
2234 76         271 my @start_rule_ids =
2235 76         148 @{ $start->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
2236 76 100       350 if (defined(
2237             my $start_alias =
2238             $start->[Marpa::PP::Internal::Symbol::NULL_ALIAS]
2239             )
2240             )
2241             {
2242 29         760 push @start_rule_ids,
2243 29         53 @{ $start_alias->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
2244             } ## end if ( defined( my $start_alias = $start->[...]))
2245              
2246 996         1666 $grammar->[Marpa::PP::Internal::Grammar::NULLABLE_SYMBOL] =
2247 76         331 [ grep { $_->[Marpa::PP::Internal::Symbol::NULLABLE] } @{$symbols} ];
  76         211  
2248              
2249 76         180 my $NFA = [];
2250 76         177 $grammar->[Marpa::PP::Internal::Grammar::NFA] = $NFA;
2251              
2252 76         434 my $state_id = 0;
2253 76         126 my @NFA_by_item;
2254              
2255             # create S0
2256 76         180 my $s0 = [];
2257 76         262 @{$s0}[
  76         325  
2258             Marpa::PP::Internal::NFA::ID,
2259             Marpa::PP::Internal::NFA::NAME,
2260             Marpa::PP::Internal::NFA::TRANSITION
2261             ]
2262             = ( $state_id++, 'S0', {} );
2263 76         162 push @{$NFA}, $s0;
  76         306  
2264              
2265             # create the other states
2266 76         150 RULE: for my $rule ( @{$rules} ) {
  76         245  
2267 1387         1833 my ( $rule_id, $rhs, $useful ) = @{$rule}[
  1387         3831  
2268             Marpa::PP::Internal::Rule::ID, Marpa::PP::Internal::Rule::RHS,
2269             Marpa::PP::Internal::Rule::USED
2270             ];
2271 1387 100       3743 next RULE if not $useful;
2272 1120         1149 for my $position ( 0 .. scalar @{$rhs} ) {
  1120         3182  
2273 3888         5832 my $new_state = [];
2274 3888         13192 @{$new_state}[
  3888         13456  
2275             Marpa::PP::Internal::NFA::ID,
2276             Marpa::PP::Internal::NFA::NAME,
2277             Marpa::PP::Internal::NFA::ITEM,
2278             Marpa::PP::Internal::NFA::TRANSITION
2279             ]
2280             = ( $state_id, 'S' . $state_id, [ $rule, $position ], {} );
2281 3888         5537 $state_id++;
2282 3888         4716 push @{$NFA}, $new_state;
  3888         6463  
2283 3888         10873 $NFA_by_item[$rule_id][$position] = $new_state;
2284             } # position
2285             } # rule
2286              
2287             # now add the transitions
2288 76         193 STATE: for my $state ( @{$NFA} ) {
  76         235  
2289 3964         4157 my ( $id, $name, $item, $transition ) = @{$state};
  3964         7693  
2290              
2291             # First, deal with transitions from state 0.
2292             # S0 is the state with no LR(0) item
2293 3964 100       12717 if ( not defined $item ) {
2294              
2295             # From S0, add an empty transition to the every NFA state
2296             # corresponding to a start rule with the dot at the beginning
2297             # of the RHS.
2298 76         199 RULE: for my $start_rule_id (@start_rule_ids) {
2299 105         202 my $start_rule = $rules->[$start_rule_id];
2300             next RULE
2301 105 50       345 if not $start_rule->[Marpa::PP::Internal::Rule::USED];
2302 105         168 push @{ $transition->{q{}} }, $NFA_by_item[$start_rule_id][0];
  105         540  
2303             } ## end for my $start_rule_id (@start_rule_ids)
2304 76         243 next STATE;
2305             } ## end if ( not defined $item )
2306              
2307             # transitions from states other than state 0:
2308              
2309 3888         5114 my $rule = $item->[Marpa::PP::Internal::LR0_item::RULE];
2310 3888         4640 my $position = $item->[Marpa::PP::Internal::LR0_item::POSITION];
2311 3888         4884 my $rule_id = $rule->[Marpa::PP::Internal::Rule::ID];
2312 3888         5422 my $next_symbol =
2313             $rule->[Marpa::PP::Internal::Rule::RHS]->[$position];
2314              
2315             # no transitions if position is after the end of the RHS
2316 3888 100       7287 if ( not defined $next_symbol ) {
2317 1120         2137 $state->[Marpa::PP::Internal::NFA::COMPLETE] = 1;
2318 1120         3640 next STATE;
2319             }
2320              
2321 2768 100       5972 if ( $next_symbol->[Marpa::PP::Internal::Symbol::NULLING] ) {
2322 430         762 $state->[Marpa::PP::Internal::NFA::AT_NULLING] = 1;
2323             }
2324              
2325             # the scanning transition: the transition if the position is at symbol X
2326             # in the RHS, via symbol X, to the state corresponding to the same
2327             # rule with the position incremented by 1
2328             # should I use ID as the key for those hashes, or NAME?
2329 2768         2896 push @{ $transition
  2768         16659  
2330             ->{ $next_symbol->[Marpa::PP::Internal::Symbol::NAME] } },
2331             $NFA_by_item[$rule_id][ $position + 1 ];
2332              
2333             # the prediction transitions: transitions if the position is at symbol X
2334             # in the RHS, via the empty symbol, to all states with X on the LHS and
2335             # position 0
2336 2768         6438 RULE:
2337 2768         3366 for my $predicted_rule_id (
2338             @{ $next_symbol->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] } )
2339             {
2340 4022         7903 my $predicted_rule = $rules->[$predicted_rule_id];
2341             next RULE
2342 4022 100       8980 if not $predicted_rule->[Marpa::PP::Internal::Rule::USED];
2343 3253         3076 push @{ $transition->{q{}} }, $NFA_by_item[$predicted_rule_id][0];
  3253         11292  
2344             } ## end for my $predicted_rule_id ( @{ $next_symbol->[...]})
2345             } ## end for my $state ( @{$NFA} )
2346              
2347 76         860 return 1;
2348             } ## end sub create_NFA
2349              
2350             # take a list of kernel NFA states, possibly with duplicates, and return
2351             # a reference to an array of the fully built Aycock-Horspool (AHFA) states.
2352             # as necessary. The build is complete, except for transitions, which are
2353             # left to be set up later.
2354             sub assign_AHFA_state_set {
2355 6744     6744   17969 my $grammar = shift;
2356 6744         12273 my $kernel_states = shift;
2357              
2358 6744         12474 my ( $symbols, $NFA_states, $AHFA_by_name, $AHFA ) = @{$grammar}[
  6744         25525  
2359             Marpa::PP::Internal::Grammar::SYMBOLS,
2360             Marpa::PP::Internal::Grammar::NFA,
2361             Marpa::PP::Internal::Grammar::AHFA_BY_NAME,
2362             Marpa::PP::Internal::Grammar::AHFA
2363             ];
2364              
2365             # Track if a state has been seen in @NFA_state_seen.
2366             # Value is Undefined if never seen.
2367             # Value is -1 if seen, but not a result
2368             # Value is >=0 if seen and a result.
2369             #
2370             # If seen and to go into result, the
2371             # value is the reset flag, which must be
2372             # 0 or 1.
2373 6744         10988 my @NFA_state_seen;
2374              
2375             # pre-allocate the array
2376 6744         9353 $#NFA_state_seen = @{$NFA_states};
  6744         35225  
2377              
2378             # The work list is an array of work items. Each work item
2379             # is an NFA state, following by an optional prediction flag.
2380 6744         31454 my @work_list = map { [ $_, 0 ] } @{$kernel_states};
  12270         42877  
  6744         18006  
2381              
2382             # Use index because we extend this list while processing it.
2383 6744         12960 my $work_list_index = -1;
2384 6744         10549 WORK_ITEM: while (1) {
2385              
2386 556123         769671 my $work_list_entry = $work_list[ ++$work_list_index ];
2387 556123 100       1099249 last WORK_ITEM if not defined $work_list_entry;
2388              
2389 549379         559477 my ( $NFA_state, $reset ) = @{$work_list_entry};
  549379         893006  
2390              
2391 549379         1012522 my $NFA_id = $NFA_state->[Marpa::PP::Internal::NFA::ID];
2392 549379 100       1366255 next WORK_ITEM if defined $NFA_state_seen[$NFA_id];
2393 168044         232098 $NFA_state_seen[$NFA_id] = -1;
2394              
2395 168044         250856 my $transition = $NFA_state->[Marpa::PP::Internal::NFA::TRANSITION];
2396              
2397             # if we are at a nulling symbol, this NFA state does NOT go into the
2398             # result, but all transitions go into the work list. All the transitions
2399             # are assumed to be (and should be) empty transitions.
2400 168044 100       348641 if ( $NFA_state->[Marpa::PP::Internal::NFA::AT_NULLING] ) {
2401 2311         6451 push @work_list, map { [ $_, $reset ] }
  2311         5620  
2402 2311         2919 map { @{$_} } values %{$transition};
  2311         3246  
  2311         5409  
2403 2311         5562 next WORK_ITEM;
2404             }
2405              
2406             # If we are here, were have an NFA state NOT at a nulling symbol.
2407             # This NFA state goes into the result, and the empty transitions
2408             # go into the worklist as reset items.
2409 165733         280940 my $empty_transitions = $transition->{q{}};
2410 165733 100       314810 if ($empty_transitions) {
2411 75770         82752 push @work_list, map { [ $_, 1 ] } @{$empty_transitions};
  534798         1065986  
  75770         146514  
2412             }
2413              
2414 165733   50     333966 $reset //= 0;
2415 165733         280613 $NFA_state_seen[$NFA_id] = $reset;
2416              
2417             } # WORK_ITEM
2418              
2419             # this will hold the AHFA state set,
2420             # which is the result
2421 6744         17787 my @result_states = ();
2422              
2423 6744         16658 RESET: for my $reset ( 0, 1 ) {
2424              
2425 12930420 100       31585150 my @NFA_ids = grep {
2426 13488         654749 defined $NFA_state_seen[$_]
2427             and $NFA_state_seen[$_] == $reset
2428             } ( 0 .. $#NFA_state_seen );
2429              
2430 13488 100       485454 next RESET if not scalar @NFA_ids;
2431              
2432 9321         90241 my $name = join q{,}, @NFA_ids;
2433 9321         32273 my $AHFA_state = $AHFA_by_name->{$name};
2434              
2435             # this is a new AHFA state -- create it
2436 9321 100       23541 if ( not $AHFA_state ) {
2437 2079         4209 my $id = scalar @{$AHFA};
  2079         5323  
2438              
2439 2079         2982 my $start_rule;
2440 2079         3656 my $lhs_list = [];
2441 2079         4452 my $complete_rules = [];
2442 2079         3026 my $AHFA_complete = 0;
2443 2079         3227 my $NFA_state_list = [ @{$NFA_states}[@NFA_ids] ];
  2079         9236  
2444 2079         3942 NFA_STATE: for my $NFA_state ( @{$NFA_state_list} ) {
  2079         6528  
2445             next NFA_STATE
2446 13410 100       35247 if not $NFA_state->[Marpa::PP::Internal::NFA::COMPLETE];
2447 1245         2116 $AHFA_complete = 1;
2448 1245         2212 my $item = $NFA_state->[Marpa::PP::Internal::NFA::ITEM];
2449 1245         2085 my $rule = $item->[Marpa::PP::Internal::LR0_item::RULE];
2450 1245         2923 my $lhs = $rule->[Marpa::PP::Internal::Rule::LHS];
2451 1245         2141 my ( $lhs_id, $lhs_is_start ) = @{$lhs}[
  1245         3666  
2452             Marpa::PP::Internal::Symbol::ID,
2453             Marpa::PP::Internal::Symbol::START
2454             ];
2455 1245         13024 $lhs_list->[$lhs_id] = 1;
2456 1245         1871 push @{ $complete_rules->[$lhs_id] }, $rule;
  1245         4751  
2457              
2458 1245 100       5561 if ($lhs_is_start) {
2459 105         342 $start_rule = $rule;
2460             }
2461             } ## end for my $NFA_state ( @{$NFA_state_list} )
2462              
2463 2079         6509 $AHFA_state->[Marpa::PP::Internal::AHFA::ID] = $id;
2464 2079         10964 $AHFA_state->[Marpa::PP::Internal::AHFA::NAME] = $name;
2465 2079         4765 $AHFA_state->[Marpa::PP::Internal::AHFA::NFA_STATES] =
2466             $NFA_state_list;
2467 2079         3519 $AHFA_state->[Marpa::PP::Internal::AHFA::RESET_ORIGIN] = $reset;
2468 2079         2961 $AHFA_state->[Marpa::PP::Internal::AHFA::START_RULE] =
2469             $start_rule;
2470 2079         3746 $AHFA_state->[Marpa::PP::Internal::AHFA::COMPLETE_RULES] =
2471             $complete_rules;
2472              
2473 1207         5965 $AHFA_state->[Marpa::PP::Internal::AHFA::COMPLETE_LHS] =
2474 2079         4848 [ map { $_->[Marpa::PP::Internal::Symbol::NAME] }
2475 48246         66559 @{$symbols}[ grep { $lhs_list->[$_] }
  2079         7434  
2476 2079         3873 ( 0 .. $#{$lhs_list} ) ] ];
2477              
2478 2079         4799 push @{$AHFA}, $AHFA_state;
  2079         4819  
2479 2079         12311 $AHFA_by_name->{$name} = $AHFA_state;
2480             } ## end if ( not $AHFA_state )
2481              
2482 9321         49290 push @result_states, $AHFA_state;
2483              
2484             } ## end for my $reset ( 0, 1 )
2485              
2486 6744         359852 return \@result_states;
2487             } ## end sub assign_AHFA_state_set
2488              
2489             sub create_AHFA {
2490 76     76   169 my $grammar = shift;
2491 76         176 my ( $symbols, $NFA, $tracing ) = @{$grammar}[
  76         234  
2492             Marpa::PP::Internal::Grammar::SYMBOLS,
2493             Marpa::PP::Internal::Grammar::NFA,
2494             Marpa::PP::Internal::Grammar::TRACING,
2495             ];
2496 76         204 my $symbol_hash = $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH];
2497              
2498 76         157 my $trace_fh;
2499 76 50       291 if ($tracing) {
2500 0         0 $trace_fh =
2501             $grammar->[Marpa::PP::Internal::Grammar::TRACE_FILE_HANDLE];
2502             }
2503              
2504 76         210 my $AHFA = $grammar->[Marpa::PP::Internal::Grammar::AHFA] = [];
2505 76         176 my $NFA_s0 = $NFA->[0];
2506              
2507             # next AHFA state to compute transitions for
2508 76         161 my $next_state_id = 0;
2509              
2510 76         212 my $initial_NFA_states =
2511             $NFA_s0->[Marpa::PP::Internal::NFA::TRANSITION]->{q{}};
2512 76 50       297 if ( not defined $initial_NFA_states ) {
2513 0         0 Marpa::PP::exception('Empty NFA, cannot create AHFA');
2514             }
2515 76         1435 $grammar->[Marpa::PP::Internal::Grammar::START_STATES] =
2516             assign_AHFA_state_set( $grammar, $initial_NFA_states );
2517              
2518             # assign_AHFA_state_set extends this array, which we are
2519             # simultaneously going through and adding transitions.
2520             # There is no problem with the process of adding transitions
2521             # overtaking assign_AHFA_state_set: if we reach a point where
2522             # all transitions have been added, and we are at the end of @$AHFA
2523             # we are finished.
2524 76         1268 while ( $next_state_id < scalar @{$AHFA} ) {
  2155         6810  
2525              
2526             # compute the AHFA state transitions from the transitions
2527             # of the NFA states of which it is composed
2528 2079         4008 my $NFA_to_states_by_symbol = {};
2529              
2530 2079         4933 my $AHFA_state = $AHFA->[ $next_state_id++ ];
2531              
2532             # aggregrate the transitions, by symbol, for every NFA state in this AHFA
2533             # state
2534 2079         2943 for my $NFA_state (
  2079         6473  
2535             @{ $AHFA_state->[Marpa::PP::Internal::AHFA::NFA_STATES] } )
2536             {
2537 13410         24785 my $transition =
2538             $NFA_state->[Marpa::PP::Internal::NFA::TRANSITION];
2539 13410         42433 NFA_TRANSITION:
2540 13410         14537 for my $symbol ( sort keys %{$transition} ) {
2541 18402         26205 my $to_states = $transition->{$symbol};
2542 18402 100       39604 next NFA_TRANSITION if $symbol eq q{};
2543 12165         12313 push @{ $NFA_to_states_by_symbol->{$symbol} }, @{$to_states};
  12165         23687  
  12165         49021  
2544             }
2545             } # $NFA_state
2546              
2547             # for each transition symbol, create the transition to the AHFA kernel state
2548 2079         3699 for my $symbol (
  24554         35151  
2549 2079         15300 sort { $symbol_hash->{$a} <=> $symbol_hash->{$b} }
2550             keys %{$NFA_to_states_by_symbol}
2551             )
2552             {
2553 6668         23045 my $to_states_by_symbol = $NFA_to_states_by_symbol->{$symbol};
2554 6668         25193 $AHFA_state->[Marpa::PP::Internal::AHFA::TRANSITION]->{$symbol} =
2555             assign_AHFA_state_set( $grammar, $to_states_by_symbol );
2556             } ## end for my $symbol ( sort { $symbol_hash->{$a} <=> $symbol_hash...})
2557             } ## end while ( $next_state_id < scalar @{$AHFA} )
2558              
2559 76         270 return;
2560              
2561             } ## end sub create_AHFA
2562              
2563             # To the reader:
2564             # You are not expected to understand the following. It is
2565             # notes toward a proof. This is useful, along with testing,
2566             # to increase confidence
2567             # that Marpa::PP correctly incorporates Leo Joop's algorithm.
2568             #
2569             # Theorem: In Marpa::PP,
2570             # all Leo completion states are in their own LR(0) state.
2571             #
2572             # Proof: Every Marpa::PP LR(0) item has its own NFA state.
2573             # (By definition, no Marpa::PP LR(0) item will have
2574             # a nulling post-dot symbol.)
2575             # The Leo completion LR(0) item will have a non-nulling symbol,
2576             # by its definiton.
2577             # Call the Leo completion item's final non-nulling symbol,
2578             # symbol S.
2579             # Suppose, for reduction to absurdity,
2580             # that another LR(0) item is combined with
2581             # the Leo completion item in creating the LR(0) DFA.
2582             # Call that other LR(0) item, item X.
2583             # If so,
2584             # there must be a Leo kernel LR(0) state where two of the
2585             # LR(0) items, after a transition on symbol S,
2586             # produce both item X and the Leo completion item.
2587             # That means that in the Leo kernel LR(0) state, there
2588             # are two LR(0) items with S as the postdot symbol.
2589             # Therefore the parent Earley set (which contains the
2590             # Leo kernel LR(0) DFA state) will have multiple
2591             # LR(0) items with S as the postdot symbol.
2592             # But by Leo's definitions, the LR(0) item with S as
2593             # the postdot symbol must be unique.
2594             # So the assumption that another LR(0) item will be
2595             # combined with a Leo completion LR(0) item in producing
2596             # a DFA state must be false.
2597             # QED
2598             #
2599             # Theorem: All Leo completion states are in their own AHFA state.
2600             # Proof: By the theorem above, all Leo completion states are in
2601             # their own state in the LR(0) DFA.
2602             # The conversion to an epsilion-DFA will not add any items to this
2603             # state, because the only item in it is a completion item.
2604             # And conversion to a split epsilon-DFA will not add items.
2605             # So the Leo completion item will remain in its own AHFA state.
2606             # QED.
2607              
2608             # Mark the Leo kernel and completion states
2609             sub mark_leo_states {
2610 76     76   192 my $grammar = shift;
2611 76         196 my $AHFA = $grammar->[Marpa::PP::Internal::Grammar::AHFA];
2612              
2613             # An Leo completion state will have only one NFA state,
2614             # and will contain a completion.
2615 76         214 STATE: for my $state ( @{$AHFA} ) {
  76         216  
2616 2079         3263 my $NFA_states = $state->[Marpa::PP::Internal::AHFA::NFA_STATES];
2617 2079 100       2644 next STATE if scalar @{$NFA_states} != 1;
  2079         5204  
2618 1298         1990 my $left_hand_sides =
2619             $state->[Marpa::PP::Internal::AHFA::COMPLETE_LHS];
2620 1298 100       1271 next STATE if not scalar @{$left_hand_sides};
  1298         3425  
2621 824         1676 my $LR0_item = $NFA_states->[0]->[Marpa::PP::Internal::NFA::ITEM];
2622 824         6694 my $rule = $LR0_item->[Marpa::PP::Internal::LR0_item::RULE];
2623 824         1522 my $rhs = $rule->[Marpa::PP::Internal::Rule::RHS];
2624             my $non_nulling = (
2625             List::Util::first {
2626 832     832   1778 not $_->[Marpa::PP::Internal::Symbol::NULLING];
2627             }
2628 824         2434 reverse @{$rhs}
  824         2566  
2629             );
2630              
2631             # In the null parse rules, there will be no non-nulling symbol
2632 824 100       3188 next STATE if not defined $non_nulling;
2633              
2634             # Not a Leo completion unless the next non-nulling symbol is on at least
2635             # one left hand side.
2636             next STATE
2637             if not scalar
2638 823 100       948 @{ $non_nulling->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] };
  823         2391  
2639 579         1802 $state->[Marpa::PP::Internal::AHFA::LEO_COMPLETION] =
2640             $rule->[Marpa::PP::Internal::Rule::LHS];
2641             } ## end for my $state ( @{$AHFA} )
2642              
2643 76         195 AHFA_STATE: for my $AHFA_state ( @{$AHFA} ) {
  76         220  
2644 2079         3314 my %symbol_count = ();
2645 13410         31285 LR0_ITEM:
2646 2079         2525 for my $LR0_item ( map { $_->[Marpa::PP::Internal::NFA::ITEM] }
  2079         4874  
2647             @{ $AHFA_state->[Marpa::PP::Internal::AHFA::NFA_STATES] } )
2648             {
2649 13410         15849 my $rule = $LR0_item->[Marpa::PP::Internal::LR0_item::RULE];
2650 13410         14679 my $position =
2651             $LR0_item->[Marpa::PP::Internal::LR0_item::POSITION];
2652 13410         19509 my $symbol = $rule->[Marpa::PP::Internal::Rule::RHS]->[$position];
2653 13410 100       25150 next LR0_ITEM if not defined $symbol;
2654 12165         23607 $symbol_count{ $symbol->[Marpa::PP::Internal::Symbol::NAME] }++;
2655             } ## end for my $LR0_item ( map { $_->[Marpa::PP::Internal::NFA::ITEM...]})
2656 2079         9993 my $transitions =
2657             $AHFA_state->[Marpa::PP::Internal::AHFA::TRANSITION];
2658 6668         11589 SYMBOL:
2659 2079         6476 for my $symbol_name (
2660             grep { $symbol_count{$_} == 1 }
2661             keys %symbol_count
2662             )
2663             {
2664 3621         6404 my $to_states = $transitions->{$symbol_name};
2665              
2666             # Since there is only one to-state, @leo_lhs
2667             # will have only one entry -- this will be the
2668             # lhs of the only rule in the Leo completion
2669             # item
2670 1312         4181 my @leo_lhs =
2671 4957         10210 map { $_->[Marpa::PP::Internal::Symbol::NAME] }
2672 4957         10071 grep {defined}
2673 3621         5742 map { $_->[Marpa::PP::Internal::AHFA::LEO_COMPLETION] }
2674 3621         3937 @{$to_states};
2675 3621         4698 $transitions->{$symbol_name} = [ @leo_lhs, @{$to_states} ];
  3621         14950  
2676             } ## end for my $symbol_name ( grep { $symbol_count{$_} == 1 }...)
2677             } ## end for my $AHFA_state ( @{$AHFA} )
2678              
2679 76         201 return;
2680             } ## end sub mark_leo_states
2681              
2682             # given a nullable symbol, create a nulling alias and make the first symbol non-nullable
2683             sub alias_symbol {
2684 140     140   225 my $grammar = shift;
2685 140         189 my $nullable_symbol = shift;
2686 140         280 my $symbol_hash = $grammar->[Marpa::PP::Internal::Grammar::SYMBOL_HASH];
2687 140         209 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
2688 140         226 my ( $accessible, $productive, $name, $null_value ) = @{$nullable_symbol}[
  140         359  
2689             Marpa::PP::Internal::Symbol::ACCESSIBLE,
2690             Marpa::PP::Internal::Symbol::PRODUCTIVE,
2691             Marpa::PP::Internal::Symbol::NAME,
2692             Marpa::PP::Internal::Symbol::NULL_VALUE,
2693             ];
2694              
2695             # create the new, nulling symbol
2696 140         421 my $alias_name =
2697             $nullable_symbol->[Marpa::PP::Internal::Symbol::NAME] . '[]';
2698 140         257 my $alias = [];
2699 140         192 $#{$alias} = Marpa::PP::Internal::Symbol::LAST_FIELD;
  140         474  
2700 140         771 $alias->[Marpa::PP::Internal::Symbol::NAME] = $alias_name;
2701 140         290 $alias->[Marpa::PP::Internal::Symbol::LH_RULE_IDS] = [];
2702 140         285 $alias->[Marpa::PP::Internal::Symbol::RH_RULE_IDS] = [];
2703 140         233 $alias->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = $accessible;
2704 140         217 $alias->[Marpa::PP::Internal::Symbol::PRODUCTIVE] = $productive;
2705 140         238 $alias->[Marpa::PP::Internal::Symbol::NULLING] = 1;
2706 140         247 $alias->[Marpa::PP::Internal::Symbol::NULL_VALUE] = $null_value;
2707 140   100     551 $nullable_symbol->[Marpa::PP::Internal::Symbol::NULLABLE] //= 0;
2708 140         239 $alias->[Marpa::PP::Internal::Symbol::NULLABLE] = 1;
2709              
2710 140         165 my $symbol_id = @{$symbols};
  140         264  
2711 140         186 push @{$symbols}, $alias;
  140         289  
2712 140         477 $alias->[Marpa::PP::Internal::Symbol::ID] = $symbol_hash->{$alias_name} =
2713             $symbol_id;
2714              
2715             # turn the original symbol into a non-nullable with a reference to the new alias
2716 140         272 $nullable_symbol->[Marpa::PP::Internal::Symbol::NULLABLE] =
2717             $nullable_symbol->[Marpa::PP::Internal::Symbol::NULLING] = 0;
2718 140         451 return $nullable_symbol->[Marpa::PP::Internal::Symbol::NULL_ALIAS] =
2719             $alias;
2720             } ## end sub alias_symbol
2721              
2722             # For efficiency, steps in the CHAF evaluation
2723             # work on a last-is-rest principle -- productions
2724             # with a CHAF head always return reference to an array
2725             # of values, of which the last value is (in turn)
2726             # a reference to an array with the "rest" of the values.
2727             # An empty array signals that there are no more.
2728              
2729             # rewrite as Chomsky-Horspool-Aycock Form
2730             sub rewrite_as_CHAF {
2731 76     76   170 my $grammar = shift;
2732              
2733 76         197 my $rules = $grammar->[Marpa::PP::Internal::Grammar::RULES];
2734 76         177 my $symbols = $grammar->[Marpa::PP::Internal::Grammar::SYMBOLS];
2735 76         172 my $old_start_symbol = $grammar->[Marpa::PP::Internal::Grammar::START];
2736              
2737             # add null aliases to symbols which need them
2738 76         136 my $symbol_count = @{$symbols};
  76         191  
2739 76         307 SYMBOL: for my $ix ( 0 .. ( $symbol_count - 1 ) ) {
2740 742         1311 my $symbol = $symbols->[$ix];
2741 742         1512 my ( $productive, $accessible, $nulling, $nullable, $null_alias ) =
2742 742         857 @{$symbol}[
2743             Marpa::PP::Internal::Symbol::PRODUCTIVE,
2744             Marpa::PP::Internal::Symbol::ACCESSIBLE,
2745             Marpa::PP::Internal::Symbol::NULLING,
2746             Marpa::PP::Internal::Symbol::NULLABLE,
2747             Marpa::PP::Internal::Symbol::NULL_ALIAS
2748             ];
2749              
2750             # not necessary is the symbol already has a null
2751             # alias
2752 742 50       1512 next SYMBOL if $null_alias;
2753              
2754             # we don't bother with unreachable symbols
2755 742 50       1380 next SYMBOL if not $productive;
2756 742 100       1845 next SYMBOL if not $accessible;
2757              
2758             # look for proper nullable symbols
2759 737 100       1404 next SYMBOL if $nulling;
2760 706 100       1789 next SYMBOL if not $nullable;
2761              
2762 111         340 alias_symbol( $grammar, $symbol );
2763             } ## end for my $ix ( 0 .. ( $symbol_count - 1 ) )
2764              
2765             # mark, or create as needed, the useful rules
2766              
2767             # get the initial rule count -- new rules will be added but we don't iterate
2768             # over them
2769 76         164 my $rule_count = @{$rules};
  76         189  
2770 76         242 RULE: for my $rule_id ( 0 .. ( $rule_count - 1 ) ) {
2771 878         1592 my $rule = $rules->[$rule_id];
2772              
2773             # Ignore rules already marked useless, but then re-mark
2774             # all rules as useless --
2775             # Rules will be considered useless unless proved otherwise
2776 878 100       2157 next RULE if not $rule->[Marpa::PP::Internal::Rule::USED];
2777 853         1023 $rule->[Marpa::PP::Internal::Rule::USED] = 0;
2778              
2779             # unreachable rules are useless
2780 853         1164 my $productive = $rule->[Marpa::PP::Internal::Rule::PRODUCTIVE];
2781 853 50       1782 next RULE if not $productive;
2782 853         1143 my $accessible = $rule->[Marpa::PP::Internal::Rule::ACCESSIBLE];
2783 853 100       2069 next RULE if not $accessible;
2784              
2785 848         1106 my $rhs = $rule->[Marpa::PP::Internal::Rule::RHS];
2786              
2787             # A nulling rule -- one with only nulling symbols on
2788             # the rhs is useless.
2789             # By this definition, it is vacuously true
2790             # that empty rules are nulling.
2791             next RULE
2792             if (
2793             not defined List::Util::first {
2794 750     750   2131 not $_->[Marpa::PP::Internal::Symbol::NULLING];
2795             }
2796 848 100       4569 @{$rhs}
  848         5346  
2797             );
2798              
2799 734         2119 my $lhs = $rule->[Marpa::PP::Internal::Rule::LHS];
2800             my $nullable = !defined List::Util::first {
2801 826   100 826   4050 not $_->[Marpa::PP::Internal::Symbol::NULLABLE]
2802             and not $_->[Marpa::PP::Internal::Symbol::NULL_ALIAS];
2803             }
2804 734         1819 @{$rhs};
  734         2829  
2805              
2806             # Keep track of whether the lhs side of any new rules we create should
2807             # be nullable. If any symbol in a production is not nullable, the lhs
2808             # is not nullable. If the original production is nullable, all symbols
2809             # are nullable, all subproductions will be, and all new lhs's should be.
2810             # But even if the original production is not nullable, some of the
2811             # subproductions may be. These will always be in a series starting from
2812             # the far right.
2813              
2814             # Going from right to left,
2815             # once the first non-nullable symbol is encountered,
2816             # that subproduction is non-nullable,
2817             # that lhs will be non-nullable, and since that
2818             # new lhs is on the far rhs of subsequent (going left) subproductions,
2819             # all subsequent subproductions and their lhs's will be non-nullable.
2820              
2821 1646   66     5406 my @aliased_rhs =
2822 734         1183 map { $_->[Marpa::PP::Internal::Symbol::NULL_ALIAS] // $_ }
2823 734         2109 @{$rhs};
2824 1646         8841 my @proper_nullable_ixes =
2825 734         1742 grep { $rhs->[$_]->[Marpa::PP::Internal::Symbol::NULL_ALIAS] }
2826 734         1250 ( 0 .. $#{$rhs} );
2827             my $last_nonnullable_ix = (
2828             List::Util::first {
2829 835     835   2576 not $aliased_rhs[$_]->[Marpa::PP::Internal::Symbol::NULLABLE];
2830             }
2831 734   100     3387 ( reverse 0 .. $#aliased_rhs )
2832             ) // -1;
2833              
2834             # we found no properly nullable symbols in the RHS, so this rule is useful without
2835             # any changes
2836 734 100       2606 if ( not scalar @proper_nullable_ixes ) {
2837 611         877 $rule->[Marpa::PP::Internal::Rule::USED] = 1;
2838 611         6223 next RULE;
2839             }
2840              
2841             # Delete these? Or turn into smart comment assertions?
2842 123 50       367 if ( $rule->[Marpa::PP::Internal::Rule::VIRTUAL_LHS] ) {
2843 0         0 Marpa::PP::exception(
2844             'Internal Error: attempted CHAF rewrite of rule with virtual LHS'
2845             );
2846             }
2847 123 50       320 if ( $rule->[Marpa::PP::Internal::Rule::VIRTUAL_RHS] ) {
2848 0         0 Marpa::PP::exception(
2849             'Internal Error: attempted CHAF rewrite of rule with virtual RHS'
2850             );
2851             }
2852              
2853             # The left hand side of the first subproduction is the lhs of the original rule
2854 123         199 my $subproduction_lhs = $lhs;
2855 123         234 my $subproduction_start_ix = 0;
2856              
2857             # break this production into subproductions with a fixed number of proper nullables,
2858             # then factor out the proper nullables into a set of productions
2859             # with only non-nullable and nulling symbols.
2860 123         136 SUBPRODUCTION: while (1) {
2861              
2862 161         199 my $subproduction_end_ix;
2863 161         225 my $proper_nullable_0_ix = $proper_nullable_ixes[0];
2864 161         223 my $proper_nullable_0_subproduction_ix =
2865             $proper_nullable_0_ix - $subproduction_start_ix;
2866              
2867 161         186 my $proper_nullable_1_ix = $proper_nullable_ixes[1];
2868 161         179 my $proper_nullable_1_subproduction_ix;
2869 161 100       365 if ( defined $proper_nullable_1_ix ) {
2870 73         272 $proper_nullable_1_subproduction_ix =
2871             $proper_nullable_1_ix - $subproduction_start_ix;
2872             }
2873              
2874 161         234 my $nothing_nulling_rhs;
2875             my $next_subproduction_lhs;
2876              
2877 161         253 given ( scalar @proper_nullable_ixes ) {
2878              
2879             # When there are 1 or 2 proper nullables
2880 161         290 when ( $_ <= 2 ) {
2881 123         165 $subproduction_end_ix = $#{$rhs};
  123         255  
2882 123         329 $nothing_nulling_rhs = [
2883 123         225 @{$rhs}[
2884             $subproduction_start_ix .. $subproduction_end_ix
2885             ]
2886             ];
2887 123         330 @proper_nullable_ixes = ();
2888             } ## end when ( $_ <= 2 )
2889              
2890             # When there are 3 or more proper nullables
2891 38         61 default {
2892 38         62 $subproduction_end_ix = $proper_nullable_1_ix - 1;
2893 38         61 shift @proper_nullable_ixes;
2894              
2895             # If the next subproduction is not nullable,
2896             # we can include two proper nullables
2897 38 100       118 if ( $proper_nullable_1_ix < $last_nonnullable_ix ) {
2898 9         13 $subproduction_end_ix++;
2899 9         15 shift @proper_nullable_ixes;
2900             }
2901              
2902 38         894 $next_subproduction_lhs = assign_symbol( $grammar,
2903             $lhs->[Marpa::PP::Internal::Symbol::NAME] . '[R'
2904             . $rule_id . q{:}
2905             . ( $subproduction_end_ix + 1 )
2906             . ']' );
2907              
2908 38         113 $next_subproduction_lhs
2909             ->[Marpa::PP::Internal::Symbol::NULLABLE] = 0;
2910 38         61 $next_subproduction_lhs
2911             ->[Marpa::PP::Internal::Symbol::NULLING] = 0;
2912 38         207 $next_subproduction_lhs
2913             ->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = 1;
2914 38         61 $next_subproduction_lhs
2915             ->[Marpa::PP::Internal::Symbol::PRODUCTIVE] = 1;
2916              
2917 38         151 $nothing_nulling_rhs = [
2918 38         75 @{$rhs}[
2919             $subproduction_start_ix .. $subproduction_end_ix
2920             ],
2921             $next_subproduction_lhs
2922             ];
2923             } ## end default
2924              
2925             } # SETUP_SUBPRODUCTION
2926              
2927 161         1172 my @factored_rh_sides = ($nothing_nulling_rhs);
2928              
2929 161 100 100     743 FACTOR: {
2930              
2931             # We have additional factored productions if
2932             # 1) there is more than one proper nullable;
2933             # 2) there's only one, but replacing it with a nulling symbol will
2934             # not make the entire production nulling
2935             #
2936             # Here and below we use the nullable flag to establish whether a
2937             # factored subproduction rhs would be nulling, on this principle:
2938             #
2939             # If substituting nulling symbols for all proper nullables does not
2940             # make a production nulling, then it is not nullable, and vice versa.
2941              
2942 161         223 last FACTOR
2943             if $nullable and not defined $proper_nullable_1_ix;
2944              
2945             # The factor rhs which nulls the last proper nullable
2946 139   100     475 my $last_nullable_subproduction_ix =
2947             $proper_nullable_1_subproduction_ix
2948             // $proper_nullable_0_subproduction_ix;
2949 139         247 my $last_nulling_rhs = [ @{$nothing_nulling_rhs} ];
  139         422  
2950 139 100 100     623 if ( $next_subproduction_lhs
2951             and $last_nullable_subproduction_ix
2952             > ( $last_nonnullable_ix - $subproduction_start_ix ) )
2953             {
2954              
2955             # Remove the final rhs symbol, which is the lhs symbol
2956             # of the next subproduction, and splice on the null
2957             # aliases for the rest of the rule.
2958             # At this point we are guaranteed all the
2959             # rest of the rhs symbols DO have a null alias.
2960 29 100       193 splice @{$last_nulling_rhs}, -1, 1, (
  99         321  
2961             map {
2962 29         55 $_->[Marpa::PP::Internal::Symbol::NULLING]
2963             ? $_
2964             : $_
2965             ->[Marpa::PP::Internal::Symbol::NULL_ALIAS]
2966 29         42 } @{$rhs}[ $subproduction_end_ix + 1 .. $#{$rhs} ]
  29         72  
2967             );
2968             } ## end if ( $next_subproduction_lhs and ...)
2969             else {
2970 110         243 $last_nulling_rhs->[$last_nullable_subproduction_ix] =
2971             $nothing_nulling_rhs
2972             ->[$last_nullable_subproduction_ix]
2973             ->[Marpa::PP::Internal::Symbol::NULL_ALIAS];
2974             } ## end else [ if ( $next_subproduction_lhs and ...)]
2975              
2976 139         294 push @factored_rh_sides, $last_nulling_rhs;
2977              
2978             # If there was only one proper nullable, then no more factors
2979 139 100       456 last FACTOR if not defined $proper_nullable_1_ix;
2980              
2981             # Now factor again, by nulling the first proper nullable
2982             # Don't include the rhs with one symbol already nulled,
2983             # if nulling anothing symbol would make the whole production
2984             # null.
2985 73         162 my @rh_sides_for_2nd_factoring = ($nothing_nulling_rhs);
2986 73 100       198 if ( not $nullable ) {
2987 31         48 push @rh_sides_for_2nd_factoring, $last_nulling_rhs;
2988             }
2989              
2990 73         142 for my $rhs_to_refactor (@rh_sides_for_2nd_factoring) {
2991 104         292 my $new_factored_rhs = [ @{$rhs_to_refactor} ];
  104         303  
2992 104         209 $new_factored_rhs->[$proper_nullable_0_subproduction_ix] =
2993             $nothing_nulling_rhs
2994             ->[$proper_nullable_0_subproduction_ix]
2995             ->[Marpa::PP::Internal::Symbol::NULL_ALIAS];
2996 104         274 push @factored_rh_sides, $new_factored_rhs;
2997             } ## end for my $rhs_to_refactor (@rh_sides_for_2nd_factoring)
2998              
2999             } # FACTOR
3000              
3001 161         310 for my $factor_rhs (@factored_rh_sides) {
3002              
3003             # if the LHS is the not LHS of the original rule, we have a
3004             # special CHAF header
3005 404         661 my $virtual_lhs = ( $subproduction_lhs != $lhs );
3006              
3007             # if a CHAF LHS was created for the next subproduction,
3008             # there is a CHAF continuation for this subproduction.
3009             # It applies to this factor if there is one of the first two
3010             # factors of more than two.
3011              
3012             # The only virtual symbol on the RHS will be the last
3013             # one. If present it will be the lhs of the next
3014             # subproduction. And, if it is nulling in this factored
3015             # subproduction, it is not a virtual symbol.
3016 404         483 my $virtual_rhs = 0;
3017 404         413 my $real_symbol_count = scalar @{$factor_rhs};
  404         591  
3018              
3019 404 100 100     1404 if ( $next_subproduction_lhs
3020             and $factor_rhs->[-1] == $next_subproduction_lhs )
3021             {
3022 94         119 $virtual_rhs = 1;
3023 94         117 $real_symbol_count--;
3024             } ## end if ( $next_subproduction_lhs and $factor_rhs->[-1] ...)
3025              
3026             # NOTE: The following comment is obsolete.
3027             # Priorities are no longer used.
3028             #
3029             # Add new rule. In assigning internal priority:
3030             # Leftmost subproductions have highest priority.
3031             # Within each subproduction,
3032             # the first factored production is
3033             # highest, last is lowest, but middle two are
3034             # reversed.
3035 404         3410 my $new_rule = add_rule(
3036             { grammar => $grammar,
3037             lhs => $subproduction_lhs,
3038             rhs => $factor_rhs,
3039             virtual_lhs => $virtual_lhs,
3040             virtual_rhs => $virtual_rhs,
3041             real_symbol_count => $real_symbol_count,
3042             action => $rule->[Marpa::PP::Internal::Rule::ACTION],
3043             ranking_action => $rule
3044             ->[Marpa::PP::Internal::Rule::RANKING_ACTION],
3045             }
3046             );
3047              
3048 404         1604 $new_rule->[Marpa::PP::Internal::Rule::USED] = 1;
3049 404         581 $new_rule->[Marpa::PP::Internal::Rule::ACCESSIBLE] = 1;
3050 404         495 $new_rule->[Marpa::PP::Internal::Rule::PRODUCTIVE] = 1;
3051 404         774 $new_rule->[Marpa::PP::Internal::Rule::ORIGINAL_RULE] = $rule;
3052 404         536 $new_rule->[Marpa::PP::Internal::Rule::VIRTUAL_START] =
3053             $subproduction_start_ix;
3054 404         942 $new_rule->[Marpa::PP::Internal::Rule::VIRTUAL_END] =
3055             $subproduction_end_ix;
3056              
3057             } # for each factored rhs
3058              
3059             # no more
3060 161 100       811 last SUBPRODUCTION if not $next_subproduction_lhs;
3061 38         132 $subproduction_lhs = $next_subproduction_lhs;
3062 38         57 $subproduction_start_ix = $subproduction_end_ix + 1;
3063 38         115 $nullable = $subproduction_start_ix > $last_nonnullable_ix;
3064              
3065             } # SUBPRODUCTION
3066              
3067             } # RULE
3068              
3069             # Create a new start symbol
3070 76         199 my $new_start_symbol;
3071 76         177 my $start_is_nulling =
3072             $old_start_symbol->[Marpa::PP::Internal::Symbol::NULLING];
3073 76         186 my $start_is_productive =
3074             $old_start_symbol->[Marpa::PP::Internal::Symbol::PRODUCTIVE];
3075 76 100       283 if ( not $start_is_nulling ) {
3076 75         413 $new_start_symbol =
3077             assign_symbol( $grammar,
3078             $old_start_symbol->[Marpa::PP::Internal::Symbol::NAME] . q{[']} );
3079 75         285 $new_start_symbol->[Marpa::PP::Internal::Symbol::NULL_VALUE] =
3080             $old_start_symbol->[Marpa::PP::Internal::Symbol::NULL_VALUE];
3081 75         173 $new_start_symbol->[Marpa::PP::Internal::Symbol::PRODUCTIVE] =
3082             $start_is_productive;
3083 75         172 $new_start_symbol->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = 1;
3084 75         177 $new_start_symbol->[Marpa::PP::Internal::Symbol::START] = 1;
3085              
3086             # Create a new start rule
3087 75         685 my $new_start_rule = add_rule(
3088             { grammar => $grammar,
3089             lhs => $new_start_symbol,
3090             rhs => [$old_start_symbol],
3091             virtual_lhs => 1,
3092             real_symbol_count => 1,
3093             }
3094             );
3095              
3096 75         318 $new_start_rule->[Marpa::PP::Internal::Rule::PRODUCTIVE] =
3097             $start_is_productive;
3098 75         379 $new_start_rule->[Marpa::PP::Internal::Rule::ACCESSIBLE] = 1;
3099 75         178 $new_start_rule->[Marpa::PP::Internal::Rule::USED] = 1;
3100             } ## end if ( not $start_is_nulling )
3101              
3102             # If we created a null alias for the original start symbol, we need
3103             # to create a nulling start rule
3104 76 100       313 my $nulling_old_start =
3105             $start_is_nulling
3106             ? $old_start_symbol
3107             : $old_start_symbol->[Marpa::PP::Internal::Symbol::NULL_ALIAS];
3108 76 100       433 if ($nulling_old_start) {
3109 30         59 my $nulling_new_start_symbol;
3110 30 100       160 if ($new_start_symbol) {
3111 29         183 $nulling_new_start_symbol =
3112             alias_symbol( $grammar, $new_start_symbol );
3113             }
3114             else {
3115 1         7 $new_start_symbol = $nulling_new_start_symbol = assign_symbol(
3116             $grammar,
3117             $old_start_symbol->[Marpa::PP::Internal::Symbol::NAME]
3118             . q{['][]}
3119             );
3120 1         4 $nulling_new_start_symbol
3121             ->[Marpa::PP::Internal::Symbol::NULL_VALUE] =
3122             $old_start_symbol->[Marpa::PP::Internal::Symbol::NULL_VALUE];
3123 1         2 $nulling_new_start_symbol
3124             ->[Marpa::PP::Internal::Symbol::PRODUCTIVE] =
3125             $start_is_productive;
3126 1         10 $nulling_new_start_symbol->[Marpa::PP::Internal::Symbol::NULLING]
3127             = 1;
3128 1         3 $nulling_new_start_symbol->[Marpa::PP::Internal::Symbol::NULLABLE]
3129             = 1;
3130 1         3 $nulling_new_start_symbol
3131             ->[Marpa::PP::Internal::Symbol::ACCESSIBLE] = 1;
3132             } ## end else [ if ($new_start_symbol) ]
3133 30         79 $nulling_new_start_symbol->[Marpa::PP::Internal::Symbol::START] = 1;
3134              
3135 30         961 my $new_start_alias_rule = add_rule(
3136             { grammar => $grammar,
3137             lhs => $nulling_new_start_symbol,
3138             rhs => [],
3139             virtual_lhs => 1,
3140             real_symbol_count => 1,
3141             }
3142             );
3143              
3144             # Nulling rules are not considered useful, but the top-level one is an exception
3145 30         127 $new_start_alias_rule->[Marpa::PP::Internal::Rule::PRODUCTIVE] =
3146             $start_is_productive;
3147 30         67 $new_start_alias_rule->[Marpa::PP::Internal::Rule::ACCESSIBLE] = 1;
3148 30         75 $new_start_alias_rule->[Marpa::PP::Internal::Rule::USED] = 1;
3149              
3150             } ## end if ($nulling_old_start)
3151              
3152 76         178 $grammar->[Marpa::PP::Internal::Grammar::START] = $new_start_symbol;
3153 76         214 return;
3154             } ## end sub rewrite_as_CHAF
3155              
3156             1;