File Coverage

blib/lib/Marpa/R2/Recognizer.pm
Criterion Covered Total %
statement 507 584 86.8
branch 151 242 62.4
condition 30 60 50.0
subroutine 37 40 92.5
pod 0 32 0.0
total 725 958 75.6


line stmt bran cond sub pod time code
1             # Copyright 2022 Jeffrey Kegler
2             # This file is part of Marpa::R2. Marpa::R2 is free software: you can
3             # redistribute it and/or modify it under the terms of the GNU Lesser
4             # General Public License as published by the Free Software Foundation,
5             # either version 3 of the License, or (at your option) any later version.
6             #
7             # Marpa::R2 is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10             # Lesser General Public License for more details.
11             #
12             # You should have received a copy of the GNU Lesser
13             # General Public License along with Marpa::R2. If not, see
14             # http://www.gnu.org/licenses/.
15              
16             package Marpa::R2::Recognizer;
17              
18 135     135   2772 use 5.010001;
  135         510  
19 135     135   836 use warnings;
  135         330  
  135         3698  
20 135     135   703 use strict;
  135         326  
  135         3230  
21 135     135   686 use English qw( -no_match_vars );
  135         288  
  135         860  
22              
23 135     135   50921 use vars qw($VERSION $STRING_VERSION);
  135         332  
  135         11932  
24             $VERSION = '13.001_000';
25             $STRING_VERSION = $VERSION;
26             ## no critic(BuiltinFunctions::ProhibitStringyEval)
27             $VERSION = eval $VERSION;
28             ## use critic
29              
30             package Marpa::R2::Internal::Recognizer;
31              
32 135     135   988 use English qw( -no_match_vars );
  135         352  
  135         864  
33              
34             my $parse_number = 0;
35              
36             # Returns the new parse object or throws an exception
37             sub Marpa::R2::Recognizer::new {
38 216     216 0 71420 my ( $class, @arg_hashes ) = @_;
39 216         633 my $recce = bless [], $class;
40              
41 216         469 my $grammar;
42             my $trace_file_handle;
43 216         527 for my $arg_hash (@arg_hashes) {
44              
45             # Need to capture the trace file handle early
46 216         359 my $value;
47 216 100       782 if ( defined( $value = $arg_hash->{trace_file_handle} ) ) {
48 5         11 delete $arg_hash->{trace_file_handle};
49 5         10 $trace_file_handle = $value;
50             }
51 216 50       727 if ( defined( $value = $arg_hash->{grammar} ) ) {
52 216         481 delete $arg_hash->{grammar};
53 216         489 $grammar = $value;
54             }
55             } ## end for my $arg_hash (@arg_hashes)
56 216 50       563 Marpa::R2::exception('No grammar specified') if not defined $grammar;
57              
58 216   66     1499 $trace_file_handle //= $grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] ;
59 216         952 local $Marpa::R2::Internal::TRACE_FH =
60             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE] = $trace_file_handle;
61              
62 216         505 $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR] = $grammar;
63              
64 216         506 my $grammar_class = ref $grammar;
65 216 50       647 Marpa::R2::exception(
66             "${class}::new() grammar arg has wrong class: $grammar_class")
67             if not $grammar_class eq 'Marpa::R2::Grammar';
68              
69 216         405 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
70 216         405 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
71              
72 216         384 my $problems = $grammar->[Marpa::R2::Internal::Grammar::PROBLEMS];
73 216 50       589 if ($problems) {
74 0         0 Marpa::R2::exception(
75             Marpa::R2::Grammar::show_problems($grammar),
76             "Attempt to parse grammar with fatal problems\n",
77             'Marpa::R2 cannot proceed',
78             );
79             } ## end if ($problems)
80              
81 216         3506 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C] =
82             Marpa::R2::Thin::R->new($grammar_c);
83 216 50       818 if ( not defined $recce_c ) {
84 0   0     0 my $error_code = $grammar_c->error_code() // -1;
85 0 0       0 if ( $error_code == $Marpa::R2::Error::NOT_PRECOMPUTED ) {
86 0         0 Marpa::R2::exception(
87             'Attempt to parse grammar which is not precomputed');
88             }
89 0         0 Marpa::R2::exception( $grammar_c->error() );
90             } ## end if ( not defined $recce_c )
91              
92 216         838 $recce_c->ruby_slippers_set(1);
93              
94 216 50 100     1445 if ( defined $grammar->[Marpa::R2::Internal::Grammar::ACTION_OBJECT]
      66        
95             or defined $grammar->[Marpa::R2::Internal::Grammar::ACTIONS]
96             or not defined $grammar->[Marpa::R2::Internal::Grammar::INTERNAL] )
97             {
98 216         749 $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE] =
99             'legacy';
100             } ## end if ( defined $grammar->[...])
101              
102 216         609 ARG_HASH: for my $arg_hash (@arg_hashes) {
103 216 100       783 if ( defined( my $value = $arg_hash->{'leo'} ) ) {
104 7 100       28 my $boolean = $value ? 1 : 0;
105 7         78 $recce->use_leo_set($boolean);
106 7         21 delete $arg_hash->{leo};
107             }
108             } ## end ARG_HASH: for my $arg_hash (@arg_hashes)
109              
110 216         559 ARG_HASH: for my $arg_hash (@arg_hashes) {
111 216 100       738 if ( defined( my $value = $arg_hash->{'event_if_expected'} ) ) {
112 2 50       6 Marpa::R2::exception(
113             'value of "event_if_expected" must be a REF to an array of symbol names'
114             ) if ref $value ne 'ARRAY';
115 2         4 for my $symbol_name ( @{$value} ) {
  2         5  
116 18         33 my $symbol_id = $tracer->symbol_by_name($symbol_name);
117 18 50       33 Marpa::exception(
118             qq{Unknown symbol in "event_if_expected" value: "$symbol_name"}
119             ) if not defined $symbol_id;
120 18         39 $recce_c->expected_symbol_event_set( $symbol_id, 1 );
121             } ## end for my $symbol_name ( @{$value} )
122 2         7 delete $arg_hash->{event_if_expected};
123             } ## end if ( defined( my $value = $arg_hash->{'event_if_expected'...}))
124             } ## end ARG_HASH: for my $arg_hash (@arg_hashes)
125              
126 216         411 $recce->[Marpa::R2::Internal::Recognizer::WARNINGS] = 1;
127 216         430 $recce->[Marpa::R2::Internal::Recognizer::RANKING_METHOD] = 'none';
128 216         380 $recce->[Marpa::R2::Internal::Recognizer::MAX_PARSES] = 0;
129 216         395 $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS] = 0;
130              
131             # Position 0 is not used because 0 indicates an unvalued token.
132             # Position 1 is reserved for undef.
133             # Position 2 is reserved for literal tokens (used in SLIF).
134 216         542 $recce->[Marpa::R2::Internal::Recognizer::TOKEN_VALUES] = [undef, undef, undef];
135              
136 216         772 $recce->reset_evaluation();
137              
138 216 50       4350 if ( not $recce_c->start_input() ) {
139 0         0 my $error = $grammar_c->error();
140 0         0 Marpa::R2::exception( 'Recognizer start of input failed: ', $error );
141             }
142 216         879 $recce->[Marpa::R2::Internal::Recognizer::EVENTS] = cook_events($recce);
143              
144 216         852 $recce->set(@arg_hashes);
145              
146 216 100       667 if ( $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS] > 1 ) {
147 1         2 my @terminals_expected = @{ $recce->terminals_expected() };
  1         4  
148 1         5 for my $terminal ( sort @terminals_expected ) {
149 1 50       2 say {$Marpa::R2::Internal::TRACE_FH}
  1         9  
150             qq{Expecting "$terminal" at earleme 0}
151             or Marpa::R2::exception("Cannot print: $ERRNO");
152             }
153             } ## end if ( $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS...])
154              
155 216         975 return $recce;
156             } ## end sub Marpa::R2::Recognizer::new
157              
158             # Not documented, at least for the moment
159             sub Marpa::R2::Recognizer::grammar {
160 31     31 0 75 $_[0]->[Marpa::R2::Internal::Recognizer::GRAMMAR];
161             }
162              
163             sub Marpa::R2::Recognizer::thin {
164 4240     4240 0 13684 $_[0]->[Marpa::R2::Internal::Recognizer::C];
165             }
166              
167             # For the non-legacy case,
168             # I reset the ordering, forcing it to be recalculated
169             # for each parse series.
170             # But I do not actually allow the ranking method to
171             # be changed once a parse is created.
172             # Since I am stabilizing Marpa::R2, the "fix" should
173             # probably be to save the overhead, rather than
174             # to allow 'ranking_method' to be changed.
175             # But for now I will do nothing.
176             # JK -- Mon Nov 24 17:35:24 PST 2014
177             sub Marpa::R2::Recognizer::reset_evaluation {
178 1286     1286 0 11093 my ($recce) = @_;
179 1286         2318 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
180 1286         2206 my $package_source =
181             $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE];
182 1286 100 100     3941 if ( defined $package_source and $package_source ne 'legacy' ) {
183              
184             # Packaage source, once legacy, stays legacy
185             # Otherwise, reset it
186 46         94 $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE] =
187             undef;
188             } ## end if ( defined $package_source and $package_source ne ...)
189 1286         2858 $recce->[Marpa::R2::Internal::Recognizer::NO_PARSE] = undef;
190 1286         2558 $recce->[Marpa::R2::Internal::Recognizer::ASF_OR_NODES] = [];
191 1286         2643 $recce->[Marpa::R2::Internal::Recognizer::B_C] = undef;
192 1286         2402 $recce->[Marpa::R2::Internal::Recognizer::EVENTS] = [];
193 1286         2376 $recce->[Marpa::R2::Internal::Recognizer::O_C] = undef;
194 1286         2053 $recce->[Marpa::R2::Internal::Recognizer::PER_PARSE_CONSTRUCTOR] = undef;
195 1286         2251 $recce->[Marpa::R2::Internal::Recognizer::READ_STRING_ERROR] = undef;
196 1286         2117 $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE] = undef;
197 1286         2090 $recce->[Marpa::R2::Internal::Recognizer::NULL_VALUES] = undef;
198              
199 1286         2516 $recce->[Marpa::R2::Internal::Recognizer::REGISTRATIONS] = undef;
200 1286         2353 $recce->[Marpa::R2::Internal::Recognizer::CLOSURE_BY_SYMBOL_ID] = undef;
201 1286         2095 $recce->[Marpa::R2::Internal::Recognizer::CLOSURE_BY_RULE_ID] = undef;
202              
203 1286         2156 $recce->[Marpa::R2::Internal::Recognizer::T_C] = undef;
204 1286         2116 $recce->[Marpa::R2::Internal::Recognizer::TREE_MODE] = undef;
205 1286         2898 return;
206             } ## end sub Marpa::R2::Recognizer::reset_evaluation
207              
208             sub Marpa::R2::Recognizer::set {
209 1310     1310 0 7554 my ( $recce, @arg_hashes ) = @_;
210 1310         2542 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
211              
212             # This may get changed below
213 1310         3608 my $trace_fh =
214             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE];
215              
216 1310         2895 for my $args (@arg_hashes) {
217              
218 1310         2808 my $ref_type = ref $args;
219 1310 50 33     5658 if ( not $ref_type or $ref_type ne 'HASH' ) {
220 0   0     0 Carp::croak(
221             'Marpa::R2 Recognizer expects args as ref to HASH, got ',
222             ( "ref to $ref_type" || 'non-reference' ),
223             ' instead'
224             );
225             } ## end if ( not $ref_type or $ref_type ne 'HASH' )
226              
227             state $recognizer_options = {
228 1310         2651 map { ( $_, 1 ) }
  2178         5260  
229             qw(
230             closures
231             end
232             event_if_expected
233             leo
234             max_parses
235             semantics_package
236             ranking_method
237             too_many_earley_items
238             trace_actions
239             trace_and_nodes
240             trace_bocage
241             trace_earley_sets
242             trace_fh
243             trace_file_handle
244             trace_or_nodes
245             trace_terminals
246             trace_values
247             warnings
248             )
249             };
250              
251 1310 50       2423 if (my @bad_options =
252 425         1754 grep { not exists $recognizer_options->{$_} }
253 1310         4859 keys %{$args}
254             )
255             {
256 0         0 Carp::croak( 'Unknown option(s) for Marpa::R2 Recognizer: ',
257             join q{ }, @bad_options );
258             } ## end if ( my @bad_options = grep { not exists $recognizer_options...})
259              
260 1310 50       3896 if ( defined( my $value = $args->{'event_if_expected'} ) ) {
261             ## It could be allowed, but it is not needed and this is simpler
262 0         0 Marpa::R2::exception(
263             q{'event_if_expected' not allowed once input has started});
264             }
265              
266 1310 50       3265 if ( defined( my $value = $args->{'leo'} ) ) {
267 0         0 Marpa::R2::exception(
268             q{Cannot reset 'leo' once input has started});
269             }
270              
271 1310 100       3213 if ( defined( my $value = $args->{'max_parses'} ) ) {
272 84         166 $recce->[Marpa::R2::Internal::Recognizer::MAX_PARSES] = $value;
273             }
274              
275 1310 100       3183 if ( defined( my $value = $args->{'semantics_package'} ) ) {
276              
277             # Not allowed once parsing is started
278 104 50       288 if ( defined $recce->[Marpa::R2::Internal::Recognizer::B_C] ) {
279 0         0 Marpa::R2::exception(
280             q{Cannot change 'semantics_package' named argument once parsing has started}
281             );
282             }
283              
284 104   50     523 $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE]
285             //= 'semantics_package';
286 104 50       349 if ( $recce
287             ->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE] ne
288             'semantics_package' )
289             {
290 0         0 Marpa::R2::exception(
291             qq{'semantics_package' named argument in conflict with other choices\n},
292             qq{ Usually this means you tried to use the discouraged 'action_object' named argument as well\n}
293             );
294             } ## end if ( $recce->[...])
295 104         213 $recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE] =
296             $value;
297             } ## end if ( defined( my $value = $args->{'semantics_package'...}))
298              
299 1310 100       3188 if ( defined( my $value = $args->{'ranking_method'} ) ) {
300              
301             # Not allowed once parsing is started
302 96 50       269 if ( defined $recce->[Marpa::R2::Internal::Recognizer::B_C] ) {
303 0         0 Marpa::R2::exception(
304             q{Cannot change ranking method once parsing has started});
305             }
306 96         190 state $ranking_methods = { map { ($_, 0) } qw(high_rule_only rule none) };
  42         171  
307             Marpa::R2::exception(
308             qq{ranking_method value is $value (should be one of },
309 0         0 ( join q{, }, map { q{'} . $_ . q{'} } keys %{$ranking_methods} ),
  0         0  
310             ')' )
311 96 50       314 if not exists $ranking_methods->{$value};
312 96         205 $recce->[Marpa::R2::Internal::Recognizer::RANKING_METHOD] =
313             $value;
314             } ## end if ( defined( my $value = $args->{'ranking_method'} ...))
315              
316 1310 100       3101 if ( defined( my $value = $args->{'trace_fh'} ) ) {
317 4         21 $trace_fh =
318             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE] =
319             $value;
320             }
321              
322 1310 100       3332 if ( defined( my $value = $args->{'trace_file_handle'} ) ) {
323 1         4 $trace_fh =
324             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE] =
325             $value;
326             }
327              
328 1310 50       3198 if ( defined( my $value = $args->{'trace_actions'} ) ) {
329 0         0 $recce->[Marpa::R2::Internal::Recognizer::TRACE_ACTIONS] = $value;
330 0 0       0 if ($value) {
331 0 0       0 say {$trace_fh} 'Setting trace_actions option'
  0         0  
332             or Marpa::R2::exception("Cannot print: $ERRNO");
333             }
334             } ## end if ( defined( my $value = $args->{'trace_actions'} ))
335              
336 1310 50       3336 if ( defined( my $value = $args->{'trace_and_nodes'} ) ) {
337 0 0       0 Marpa::R2::exception(
338             'trace_and_nodes must be set to a number >= 0')
339             if $value !~ /\A\d+\z/xms;
340 0         0 $recce->[Marpa::R2::Internal::Recognizer::TRACE_AND_NODES] =
341             $value + 0;
342 0 0       0 if ($value) {
343 0 0       0 say {$trace_fh} "Setting trace_and_nodes option to $value"
  0         0  
344             or Marpa::R2::exception("Cannot print: $ERRNO");
345             }
346             } ## end if ( defined( my $value = $args->{'trace_and_nodes'}...))
347              
348 1310 50       3249 if ( defined( my $value = $args->{'trace_bocage'} ) ) {
349 0 0       0 Marpa::R2::exception('trace_bocage must be set to a number >= 0')
350             if $value !~ /\A\d+\z/xms;
351 0         0 $recce->[Marpa::R2::Internal::Recognizer::TRACE_BOCAGE] =
352             $value + 0;
353 0 0       0 if ($value) {
354 0 0       0 say {$trace_fh} "Setting trace_bocage option to $value"
  0         0  
355             or Marpa::R2::exception("Cannot print: $ERRNO");
356             }
357             } ## end if ( defined( my $value = $args->{'trace_bocage'} ) )
358              
359 1310 50       3351 if ( defined( my $value = $args->{'trace_or_nodes'} ) ) {
360 0 0       0 Marpa::R2::exception(
361             'trace_or_nodes must be set to a number >= 0')
362             if $value !~ /\A\d+\z/xms;
363 0         0 $recce->[Marpa::R2::Internal::Recognizer::TRACE_OR_NODES] =
364             $value + 0;
365 0 0       0 if ($value) {
366 0 0       0 say {$trace_fh} "Setting trace_or_nodes option to $value"
  0         0  
367             or Marpa::R2::exception("Cannot print: $ERRNO");
368             }
369             } ## end if ( defined( my $value = $args->{'trace_or_nodes'} ...))
370              
371 1310 100       3451 if ( defined( my $value = $args->{'trace_terminals'} ) ) {
372 5 50       31 $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS] =
373             Scalar::Util::looks_like_number($value) ? $value : 0;
374 5 50       18 if ($value) {
375 5 50       11 say {$trace_fh} 'Setting trace_terminals option'
  5         35  
376             or Marpa::R2::exception("Cannot print: $ERRNO");
377             }
378             } ## end if ( defined( my $value = $args->{'trace_terminals'}...))
379              
380 1310 50       3121 if ( defined( my $value = $args->{'trace_earley_sets'} ) ) {
381 0         0 $recce->[Marpa::R2::Internal::Recognizer::TRACE_EARLEY_SETS] =
382             $value;
383 0 0       0 if ($value) {
384 0 0       0 say {$trace_fh} 'Setting trace_earley_sets option'
  0         0  
385             or Marpa::R2::exception("Cannot print: $ERRNO");
386             }
387             } ## end if ( defined( my $value = $args->{'trace_earley_sets'...}))
388              
389 1310 100       3118 if ( defined( my $value = $args->{'trace_values'} ) ) {
390 4         18 $recce->[Marpa::R2::Internal::Recognizer::TRACE_VALUES] = $value;
391 4 100       13 if ($value) {
392 3 50       9 say {$trace_fh} 'Setting trace_values option'
  3         26  
393             or Marpa::R2::exception("Cannot print: $ERRNO");
394             }
395             } ## end if ( defined( my $value = $args->{'trace_values'} ) )
396              
397 1310 100       3140 if ( defined( my $value = $args->{'end'} ) ) {
398              
399             # Not allowed once evaluation is started
400 90 50       219 if ( defined $recce->[Marpa::R2::Internal::Recognizer::B_C] ) {
401 0         0 Marpa::R2::exception(
402             q{Cannot reset end once evaluation has started});
403             }
404 90         158 $recce->[Marpa::R2::Internal::Recognizer::END_OF_PARSE] = $value;
405             } ## end if ( defined( my $value = $args->{'end'} ) )
406              
407 1310 100       3146 if ( defined( my $value = $args->{'closures'} ) ) {
408              
409             # Not allowed once evaluation is started
410 35 50       96 if ( defined $recce->[Marpa::R2::Internal::Recognizer::B_C] ) {
411 0         0 Marpa::R2::exception(
412             q{Cannot reset closures once evaluation has started});
413             }
414 35         69 my $closures =
415             $recce->[Marpa::R2::Internal::Recognizer::CLOSURES] = $value;
416 35         60 for my $action ( keys %{$closures} ) {
  35         683  
417 2980         4259 my $closure = $closures->{$action};
418 2980 50       5488 Marpa::R2::exception(qq{Bad closure for action "$action"})
419             if ref $closure ne 'CODE';
420             }
421             } ## end if ( defined( my $value = $args->{'closures'} ) )
422              
423 1310 50       3292 if ( defined( my $value = $args->{'warnings'} ) ) {
424 0         0 $recce->[Marpa::R2::Internal::Recognizer::WARNINGS] = $value;
425             }
426              
427 1310 100       4340 if ( defined( my $value = $args->{'too_many_earley_items'} ) ) {
428 2         15 $recce_c->earley_item_warning_threshold_set($value);
429             }
430              
431             } ## end for my $args (@arg_hashes)
432              
433 1310         3513 return 1;
434             } ## end sub Marpa::R2::Recognizer::set
435              
436             sub Marpa::R2::Recognizer::latest_earley_set {
437 1383     1383 0 2664 my ($recce) = @_;
438 1383         2285 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
439 1383         3847 return $recce_c->latest_earley_set();
440             }
441              
442             sub Marpa::R2::Recognizer::check_terminal {
443 1     1 0 8 my ( $recce, $name ) = @_;
444 1         2 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
445 1         6 return $grammar->check_terminal($name);
446             }
447              
448             sub Marpa::R2::Recognizer::exhausted {
449 321     321 0 575 my ($recce) = @_;
450 321         516 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
451 321         1073 return $recce_c->is_exhausted();
452             }
453              
454             sub Marpa::R2::Recognizer::current_earleme {
455 1526     1526 0 2585 my ($recce) = @_;
456 1526         2284 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
457 1526         3908 return $recce_c->current_earleme();
458             }
459              
460             sub Marpa::R2::Recognizer::furthest_earleme {
461 0     0 0 0 my ($recce) = @_;
462 0         0 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
463 0         0 return $recce_c->furthest_earleme();
464             }
465              
466             sub Marpa::R2::Recognizer::earleme {
467 1467     1467 0 18352 my ( $recce, $earley_set_id ) = @_;
468 1467         1946 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
469 1467         2934 return $recce_c->earleme($earley_set_id);
470             }
471              
472             sub Marpa::R2::Recognizer::expected_symbol_event_set {
473 7     7 0 39 my ( $recce, $symbol_name, $value ) = @_;
474 7         11 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
475 7         10 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
476 7         28 my $symbol_id =
477             $grammar->[Marpa::R2::Internal::Grammar::TRACER]
478             ->symbol_by_name($symbol_name);
479 7 50       16 Marpa::exception(qq{Unknown symbol: "$symbol_name"})
480             if not defined $symbol_id;
481 7         29 return $recce_c->expected_symbol_event_set( $symbol_id, $value );
482             } ## end sub Marpa::R2::Recognizer::expected_symbol_event_set
483              
484             # Now useless and deprecated
485 0     0 0 0 sub Marpa::R2::Recognizer::strip { return 1; }
486              
487             # Viewing methods, for debugging
488              
489             sub Marpa::R2::Recognizer::progress {
490 207     207 0 61930 my ( $recce, $ordinal_arg ) = @_;
491 207         357 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
492 207         435 my $latest_earley_set = $recce->latest_earley_set();
493 207         324 my $ordinal;
494             SET_ORDINAL: {
495 207 100       296 if ( not defined $ordinal_arg ) {
  207         502  
496 3         9 $ordinal = $latest_earley_set;
497 3         7 last SET_ORDINAL;
498             }
499 204 50       624 if ( $ordinal_arg > $latest_earley_set ) {
500 0         0 Marpa::R2::exception(
501             qq{Argument out of bounds in recce->progress($ordinal_arg)\n},
502             qq{ Argument specifies Earley set after the latest Earley set 0\n},
503             qq{ The latest Earley set is Earley set $latest_earley_set\n}
504             );
505             } ## end if ( $ordinal_arg > $latest_earley_set )
506 204 100       424 if ( $ordinal_arg >= 0 ) {
507 196         287 $ordinal = $ordinal_arg;
508 196         376 last SET_ORDINAL;
509             }
510              
511             # If we are here, $ordinal_arg < 0
512 8         16 $ordinal = $latest_earley_set + 1 + $ordinal_arg;
513 8 50       24 Marpa::R2::exception(
514             qq{Argument out of bounds in recce->progress($ordinal_arg)\n},
515             qq{ Argument specifies Earley set before Earley set 0\n}
516             ) if $ordinal < 0;
517             } ## end SET_ORDINAL:
518 207         380 my $result = [];
519 207         5845 $recce_c->progress_report_start($ordinal);
520 207         357 ITEM: while (1) {
521 20704         36434 my @item = $recce_c->progress_item();
522 20704 100       34222 last ITEM if not defined $item[0];
523 20497         23997 push @{$result}, [@item];
  20497         36834  
524             }
525 207         846 $recce_c->progress_report_finish();
526 207         609 return $result;
527             } ## end sub Marpa::R2::Recognizer::progress
528              
529             sub Marpa::R2::Recognizer::show_progress {
530 4     4 0 1090 my ( $recce, $start_ordinal, $end_ordinal ) = @_;
531 4         12 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
532 4         11 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
533              
534 4         19 my $last_ordinal = $recce->latest_earley_set();
535              
536 4 100       26 if ( not defined $start_ordinal ) {
537 2         7 $start_ordinal = $last_ordinal;
538             }
539 4 50       19 if ( $start_ordinal < 0 ) {
540 0         0 $start_ordinal += $last_ordinal + 1;
541             }
542             else {
543 4 50 33     28 if ( $start_ordinal < 0 or $start_ordinal > $last_ordinal ) {
544             return
545 0         0 "Marpa::PP::Recognizer::show_progress start index is $start_ordinal, "
546             . "must be in range 0-$last_ordinal";
547             }
548             } ## end else [ if ( $start_ordinal < 0 ) ]
549              
550 4 100       19 if ( not defined $end_ordinal ) {
551 3         7 $end_ordinal = $start_ordinal;
552             }
553             else {
554 1         2 my $end_ordinal_argument = $end_ordinal;
555 1 50       4 if ( $end_ordinal < 0 ) {
556 1         4 $end_ordinal += $last_ordinal + 1;
557             }
558 1 50       3 if ( $end_ordinal < 0 ) {
559             return
560 0         0 "Marpa::PP::Recognizer::show_progress end index is $end_ordinal_argument, "
561             . sprintf ' must be in range %d-%d', -( $last_ordinal + 1 ),
562             $last_ordinal;
563             } ## end if ( $end_ordinal < 0 )
564             } ## end else [ if ( not defined $end_ordinal ) ]
565              
566 4         12 my $text = q{};
567 4         22 for my $current_ordinal ( $start_ordinal .. $end_ordinal ) {
568 7         24 my $current_earleme = $recce->earleme($current_ordinal);
569 7         25 my %by_rule_by_position = ();
570 7         13 for my $progress_item ( @{ $recce->progress($current_ordinal) } ) {
  7         23  
571 55         77 my ( $rule_id, $position, $origin ) = @{$progress_item};
  55         92  
572 55 100       108 if ( $position < 0 ) {
573 34         60 $position = $grammar_c->rule_length($rule_id);
574             }
575 55         153 $by_rule_by_position{$rule_id}->{$position}->{$origin}++;
576             } ## end for my $progress_item ( @{ $recce->progress($current_ordinal...)})
577              
578 7         93 for my $rule_id ( sort { $a <=> $b } keys %by_rule_by_position ) {
  24         57  
579 21         40 my $by_position = $by_rule_by_position{$rule_id};
580 21         33 for my $position ( sort { $a <=> $b } keys %{$by_position} ) {
  11         36  
  21         83  
581 31         52 my $raw_origins = $by_position->{$position};
582 31         47 my @origins = sort { $a <=> $b } keys %{$raw_origins};
  65         96  
  31         88  
583 31         104 my $origins_count = scalar @origins;
584 31         55 my $origin_desc;
585 31 100       69 if ( $origins_count <= 3 ) {
586 29         59 $origin_desc = join q{,}, @origins;
587             }
588             else {
589 2         10 $origin_desc = $origins[0] . q{...} . $origins[-1];
590             }
591              
592 31         90 my $rhs_length = $grammar_c->rule_length($rule_id);
593 31         48 my $item_text;
594              
595             # flag indicating whether we need to show the dot in the rule
596 31 100       96 if ( $position >= $rhs_length ) {
    100          
597 14         29 $item_text .= "F$rule_id";
598             }
599             elsif ($position) {
600 5         15 $item_text .= "R$rule_id:$position";
601             }
602             else {
603 12         34 $item_text .= "P$rule_id";
604             }
605 31 100       72 $item_text .= " x$origins_count" if $origins_count > 1;
606 31         78 $item_text
607             .= q{ @} . $origin_desc . q{-} . $current_earleme . q{ };
608 31         88 $item_text
609             .= $grammar->show_dotted_rule( $rule_id, $position );
610 31         127 $text .= $item_text . "\n";
611             } ## end for my $position ( sort { $a <=> $b } keys %{...})
612             } ## end for my $rule_id ( sort { $a <=> $b } keys ...)
613              
614             } ## end for my $current_ordinal ( $start_ordinal .. $end_ordinal)
615 4         21 return $text;
616             } ## end sub Marpa::R2::Recognizer::show_progress
617              
618             sub Marpa::R2::Recognizer::read {
619 2276     2276 0 18061 my $arg_count = scalar @_;
620 2276         5256 my ( $recce, $symbol_name, $value ) = @_;
621 2276 100       4905 return if not $recce->alternative( $symbol_name, \$value );
622 2274         4692 return $recce->earleme_complete();
623             } ## end sub Marpa::R2::Recognizer::read
624              
625             sub Marpa::R2::Recognizer::alternative {
626              
627 4264     4264 0 10541 my ( $recce, $symbol_name, $value_ref, $length ) = @_;
628              
629 4264 50 33     15502 Marpa::R2::exception(
630             'No recognizer object for Marpa::R2::Recognizer::tokens')
631             if not defined $recce
632             or ref $recce ne 'Marpa::R2::Recognizer';
633              
634 4264 50       8026 Marpa::R2::exception(
635             "recce->alternative(): symbol name is undefined\n",
636             " The symbol name cannot be undefined\n"
637             ) if not defined $symbol_name;
638              
639 4264 50       8146 Marpa::R2::exception('Attempt to read token after parsing is finished')
640             if $recce->[Marpa::R2::Internal::Recognizer::FINISHED];
641              
642 4264         5968 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
643 4264         9440 my $trace_fh =
644             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE];
645 4264         6305 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
646 4264         5741 my $token_values =
647             $recce->[Marpa::R2::Internal::Recognizer::TOKEN_VALUES];
648 4264         10291 my $symbol_id =
649             $grammar->[Marpa::R2::Internal::Grammar::TRACER]
650             ->symbol_by_name($symbol_name);
651              
652 4264 50       8950 if ( not defined $symbol_id ) {
653 0         0 Marpa::R2::exception(
654             qq{alternative(): symbol "$symbol_name" does not exist});
655             }
656              
657 4264         5781 my $value_ix = 1; # undef
658             SET_VALUE_IX: {
659 4264 100       5728 last SET_VALUE_IX if not defined $value_ref;
  4264         7280  
660 3994         6482 my $ref_type = ref $value_ref;
661 3994 0 33     8165 if ( $ref_type ne 'SCALAR'
      33        
662             and $ref_type ne 'REF'
663             and $ref_type ne 'VSTRING' )
664             {
665 0         0 Marpa::R2::exception('alternative(): value must be undef or ref');
666             } ## end if ( $ref_type ne 'SCALAR' and $ref_type ne 'REF' and...)
667 3994         5257 my $value = ${$value_ref};
  3994         6576  
668 3994 100       7635 last SET_VALUE_IX if not defined $value;
669 3649         4823 $value_ix = scalar @{$token_values};
  3649         5336  
670 3649         4995 push @{$token_values}, $value;
  3649         8441  
671             } ## end SET_VALUE_IX:
672 4264   100     13346 $length //= 1;
673              
674             # value_ix is *never* zero.
675 4264         11755 my $result = $recce_c->alternative( $symbol_id, $value_ix, $length );
676              
677 4264         6929 my $trace_terminals =
678             $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS];
679 4264 100       7604 if ($trace_terminals) {
680 13 100       42 my $verb =
681             $result == $Marpa::R2::Error::NONE ? 'Accepted' : 'Rejected';
682 13         31 my $current_earleme = $recce_c->current_earleme();
683 13 50       19 say {$trace_fh} qq{$verb "$symbol_name" at $current_earleme-}
  13         62  
684             . ( $length + $current_earleme )
685             or Marpa::R2::exception("Cannot print: $ERRNO");
686             } ## end if ($trace_terminals)
687              
688 4264 100       13922 return 1 if $result == $Marpa::R2::Error::NONE;
689              
690             # The last two are perhaps unnecessary or arguable,
691             # but they preserve compatibility with Marpa::XS
692             return
693 285 100 66     1226 if $result == $Marpa::R2::Error::UNEXPECTED_TOKEN_ID
      100        
694             || $result == $Marpa::R2::Error::NO_TOKEN_EXPECTED_HERE
695             || $result == $Marpa::R2::Error::INACCESSIBLE_TOKEN;
696              
697 3         10 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
698 3         23 Marpa::R2::exception( $grammar_c->error() );
699              
700             } ## end sub Marpa::R2::Recognizer::alternative
701              
702             # Perform the completion step on an earley set
703              
704             sub Marpa::R2::Recognizer::end_input {
705 110     110 0 579 my ($recce) = @_;
706 110         189 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
707 110         340 my $furthest_earleme = $recce_c->furthest_earleme();
708 110         405 while ( $recce_c->current_earleme() < $furthest_earleme ) {
709 20030         33475 $recce->earleme_complete();
710             }
711 110         229 $recce->[Marpa::R2::Internal::Recognizer::FINISHED] = 1;
712 110         226 return 1;
713             } ## end sub Marpa::R2::Recognizer::end_input
714              
715             sub Marpa::R2::Recognizer::terminals_expected {
716 1317     1317 0 2602 my ($recce) = @_;
717 1317         2094 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
718 1317         2247 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
719 1317         8730 return [ map { $grammar->symbol_name($_) }
  43903         80870  
720             $recce_c->terminals_expected() ];
721             } ## end sub Marpa::R2::Recognizer::terminals_expected
722              
723             sub cook_events {
724 296     296   655 my ($recce) = @_;
725 296         532 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
726 296         526 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
727 296         521 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
728              
729 296         525 my @cooked_events = ();
730 296         849 my $event_count = $grammar_c->event_count();
731 296         998 EVENT: for ( my $event_ix = 0; $event_ix < $event_count; $event_ix++ ) {
732 116         562 my ( $event_type, $value ) = $grammar_c->event($event_ix);
733 116 100       416 if ( $event_type eq 'MARPA_EVENT_EARLEY_ITEM_THRESHOLD' ) {
734             say {
735 5 50       9 $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE] }
  5         50  
736             "Earley item count ($value) exceeds warning threshold"
737             or die "say: $ERRNO";
738 5         23 push @cooked_events, ['EARLEY_ITEM_THRESHOLD'];
739 5         16 next EVENT;
740             } ## end if ( $event_type eq 'MARPA_EVENT_EARLEY_ITEM_THRESHOLD')
741 111 100       257 if ( $event_type eq 'MARPA_EVENT_SYMBOL_EXPECTED' ) {
742 78         194 push @cooked_events,
743             [ 'SYMBOL_EXPECTED', $grammar->symbol_name($value) ];
744 78         195 next EVENT;
745             }
746 33 50       93 if ( $event_type eq 'MARPA_EVENT_EXHAUSTED' ) {
747 33         118 push @cooked_events, ['EXHAUSTED'];
748 33         129 next EVENT;
749             }
750             } ## end EVENT: for ( my $event_ix = 0; $event_ix < $event_count; ...)
751 296         869 return \@cooked_events;
752             } ## end sub cook_events
753              
754             sub Marpa::R2::Recognizer::earleme_complete {
755 22404     22404 0 36296 my ($recce) = @_;
756              
757 22404         28824 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
758 22404         35718 local $Marpa::R2::Internal::TRACE_FH =
759             $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE];
760 22404         27899 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
761 22404         28192 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
762              
763 22404         60599 my $event_count = $recce_c->earleme_complete();
764 22404 100       43766 $recce->[Marpa::R2::Internal::Recognizer::EVENTS] =
765             $event_count ? cook_events($recce) : [];
766              
767 22404 50       38276 if ( $recce->[Marpa::R2::Internal::Recognizer::TRACE_EARLEY_SETS] ) {
768 0         0 my $latest_set = $recce_c->latest_earley_set();
769 0 0       0 print {$Marpa::R2::Internal::TRACE_FH} "=== Earley set $latest_set\n"
  0         0  
770             or Marpa::R2::exception("Cannot print: $ERRNO");
771 0 0       0 print {$Marpa::R2::Internal::TRACE_FH}
  0         0  
772             Marpa::R2::show_earley_set($recce, $latest_set)
773             or Marpa::R2::exception("Cannot print: $ERRNO");
774             } ## end if ( $recce->[Marpa::R2::Internal::Recognizer::TRACE_EARLEY_SETS...])
775              
776 22404         27787 my $trace_terminals =
777             $recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS];
778 22404 100       36328 if ( $trace_terminals > 1 ) {
779 3         7 my $current_earleme = $recce_c->current_earleme();
780 3         6 my $terminals_expected = $recce->terminals_expected();
781 3         5 for my $terminal ( @{$terminals_expected} ) {
  3         7  
782 3 50       5 say {$Marpa::R2::Internal::TRACE_FH}
  3         17  
783             qq{Expecting "$terminal" at $current_earleme}
784             or Marpa::R2::exception("Cannot print: $ERRNO");
785             }
786             } ## end if ( $trace_terminals > 1 )
787              
788 22404         53963 return $event_count;
789              
790             } ## end sub Marpa::R2::Recognizer::earleme_complete
791              
792             sub Marpa::R2::Recognizer::events {
793 101     101 0 436 my ($recce) = @_;
794 101         213 return $recce->[Marpa::R2::Internal::Recognizer::EVENTS];
795             }
796              
797             my @escape_by_ord = ();
798             $escape_by_ord[ ord q{\\} ] = q{\\\\};
799             $escape_by_ord[ ord eval qq{"$_"} ] = $_
800             for "\\t", "\\r", "\\f", "\\b", "\\a", "\\e";
801             $escape_by_ord[0xa] = '\\n';
802             $escape_by_ord[$_] //= chr $_ for 32 .. 126;
803             $escape_by_ord[$_] //= sprintf( "\\x%02x", $_ ) for 0 .. 255;
804              
805             sub Marpa::R2::escape_string {
806 18     18 0 69 my ( $string, $length ) = @_;
807 18         44 my $reversed = $length < 0;
808 18 100       40 if ($reversed) {
809 9         31 $string = reverse $string;
810 9         26 $length = -$length;
811             }
812 18         40 my @escaped_chars = ();
813 18         95 ORD: for my $ord ( map {ord} split //xms, $string ) {
  127         204  
814 127 50       217 last ORD if $length <= 0;
815 127   66     305 my $escaped_char = $escape_by_ord[$ord] // sprintf( "\\x{%04x}", $ord );
816 127         159 $length -= length $escaped_char;
817 127         226 push @escaped_chars, $escaped_char;
818             } ## end for my $ord ( map {ord} split //xms, $string )
819 18 100       82 @escaped_chars = reverse @escaped_chars if $reversed;
820 18         53 IX: for my $ix ( reverse 0 .. $#escaped_chars ) {
821              
822             # only trailing spaces are escaped
823 28 100       76 last IX if $escaped_chars[$ix] ne q{ };
824 10         23 $escaped_chars[$ix] = '\\s';
825             } ## end IX: for my $ix ( reverse 0 .. $#escaped_chars )
826 18         189 return join q{}, @escaped_chars;
827             } ## end sub escape_string
828              
829             # INTERNAL OK AFTER HERE _marpa_
830              
831             sub Marpa::R2::Recognizer::use_leo_set {
832 7     7 0 20 my ( $recce, $boolean ) = @_;
833 7         16 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
834 7         27 return $recce_c->_marpa_r_is_use_leo_set($boolean);
835             }
836              
837             # Not intended to be documented.
838             # Returns the size of the last completed earley set.
839             # For testing, especially that the Leo items
840             # are doing their job.
841             sub Marpa::R2::Recognizer::earley_set_size {
842 179     179 0 584 my ( $recce, $set_id ) = @_;
843 179         247 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
844 179   33     348 $set_id //= $recce_c->latest_earley_set();
845 179         452 return $recce_c->_marpa_r_earley_set_size($set_id);
846             }
847              
848             sub ahm_describe {
849 1994     1994   3166 my ($recce, $ahm_id) = @_;
850 1994         2862 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
851 1994         2507 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
852 1994         2550 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
853 1994         3559 my $irl_id = $grammar_c->_marpa_g_ahm_irl($ahm_id);
854 1994         3353 my $dot_position = $grammar_c->_marpa_g_ahm_position($ahm_id);
855 1994 100       3616 if ($dot_position < 0) { return 'R' . $irl_id . q{$} }
  693         2537  
856 1301         4839 return 'R' . $irl_id . q{:} . $dot_position;
857             }
858              
859             sub Marpa::R2::show_lim {
860 670     670 0 966 my ($recce) = @_;
861 670         889 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
862 670         839 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
863 670         869 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
864 670         1292 my $leo_base_state = $recce_c->_marpa_r_leo_base_state();
865 670 100       1374 return if not defined $leo_base_state;
866 188         350 my $trace_earley_set = $recce_c->_marpa_r_trace_earley_set();
867 188         355 my $trace_earleme = $recce_c->earleme($trace_earley_set);
868 188         333 my $postdot_symbol_id = $recce_c->_marpa_r_postdot_item_symbol();
869 188         473 my $postdot_symbol_name = $tracer->isy_name($postdot_symbol_id);
870 188         413 my $predecessor_symbol_id = $recce_c->_marpa_r_leo_predecessor_symbol();
871 188         323 my $base_origin_set_id = $recce_c->_marpa_r_leo_base_origin();
872 188         335 my $base_origin_earleme = $recce_c->earleme($base_origin_set_id);
873              
874 188         456 my $text = sprintf 'L%d@%d', $postdot_symbol_id, $trace_earleme;
875 188         391 my @link_texts = qq{"$postdot_symbol_name"};
876 188 100       330 if ( defined $predecessor_symbol_id ) {
877 185         423 push @link_texts, sprintf 'L%d@%d', $predecessor_symbol_id,
878             $base_origin_earleme;
879             }
880 188         409 push @link_texts, sprintf 'S%d@%d-%d', $leo_base_state,
881             $base_origin_earleme,
882             $trace_earleme;
883 188         451 $text .= ' [' . ( join '; ', @link_texts ) . ']';
884 188         425 return $text;
885             } ## end sub Marpa::R2::show_lim
886              
887             sub Marpa::R2::show_leo_item {
888 0     0 0 0 my ($recce) = @_;
889 0         0 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
890 0         0 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
891 0         0 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
892 0         0 my $leo_base_state = $recce_c->_marpa_r_leo_base_state();
893 0 0       0 return if not defined $leo_base_state;
894 0         0 my $trace_earley_set = $recce_c->_marpa_r_trace_earley_set();
895 0         0 my $trace_earleme = $recce_c->earleme($trace_earley_set);
896 0         0 my $postdot_symbol_id = $recce_c->_marpa_r_postdot_item_symbol();
897 0         0 my $postdot_symbol_name = $tracer->isy_name($postdot_symbol_id);
898             # my $predecessor_symbol_id = $recce_c->_marpa_r_leo_predecessor_symbol();
899 0         0 my $base_origin_set_id = $recce_c->_marpa_r_leo_base_origin();
900 0         0 my $base_origin_earleme = $recce_c->earleme($base_origin_set_id);
901              
902 0         0 my $text = sprintf 'L@%d', $trace_earleme;
903 0         0 my @link_texts = ('-');
904 0         0 push @link_texts, qq{"$postdot_symbol_name"};
905 0         0 push @link_texts, "$base_origin_earleme";
906 0         0 $text .= ' [' . ( join '; ', @link_texts ) . ']';
907 0         0 return $text;
908             } ## end sub Marpa::R2::show_leo_item
909              
910             # Assumes trace token source link set by caller
911             sub Marpa::R2::show_token_link_choice {
912 101     101 0 320 my ( $recce, $current_earleme ) = @_;
913 101         175 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
914 101         155 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
915 101         174 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
916 101         203 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
917 101         154 my $text = q{};
918 101         149 my @pieces = ();
919 101         262 my ( $token_id, $value_ix ) = $recce_c->_marpa_r_source_token();
920 101         219 my $predecessor_ahm = $recce_c->_marpa_r_source_predecessor_state();
921 101         203 my $origin_set_id = $recce_c->_marpa_r_earley_item_origin();
922 101         224 my $origin_earleme = $recce_c->earleme($origin_set_id);
923 101         187 my $middle_earleme = $origin_earleme;
924              
925 101 50       220 if ( defined $predecessor_ahm ) {
926 101         184 my $middle_set_id = $recce_c->_marpa_r_source_middle();
927 101         188 $middle_earleme = $recce_c->earleme($middle_set_id);
928 101         221 push @pieces,
929             'c='
930             . ahm_describe($recce, $predecessor_ahm)
931             . q{@}
932             . $origin_earleme . q{-}
933             . $middle_earleme;
934             } ## end if ( defined $predecessor_ahm )
935 101         294 my $symbol_name = $tracer->isy_name($token_id);
936 101         242 push @pieces, 's=' . $symbol_name;
937 101         182 my $token_length = $current_earleme - $middle_earleme;
938 101         214 my $value =
939             $recce->[Marpa::R2::Internal::Recognizer::TOKEN_VALUES]->[$value_ix];
940 101         425 my $token_dump = Data::Dumper->new( [ \$value ] )->Terse(1)->Dump;
941 101         4929 chomp $token_dump;
942 101         252 push @pieces, "t=$token_dump";
943 101         673 return '[' . ( join '; ', @pieces ) . ']';
944             } ## end sub Marpa::R2::show_token_link_choice
945              
946             # Assumes trace completion source link set by caller
947             sub Marpa::R2::show_completion_link_choice {
948 236     236 0 458 my ( $recce, $link_ahm_id, $current_earleme ) = @_;
949 236         398 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
950 236         337 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
951 236         331 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
952 236         348 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
953 236         355 my $text = q{};
954 236         357 my @pieces = ();
955 236         444 my $predecessor_state = $recce_c->_marpa_r_source_predecessor_state();
956 236         436 my $origin_set_id = $recce_c->_marpa_r_earley_item_origin();
957 236         479 my $origin_earleme = $recce_c->earleme($origin_set_id);
958 236         417 my $middle_set_id = $recce_c->_marpa_r_source_middle();
959 236         403 my $middle_earleme = $recce_c->earleme($middle_set_id);
960              
961 236 50       444 if ( defined $predecessor_state ) {
962 236         395 push @pieces,
963             'p='
964             . ahm_describe($recce, $predecessor_state) . q{@}
965             . $origin_earleme . q{-}
966             . $middle_earleme;
967             } ## end if ( defined $predecessor_state )
968 236         519 push @pieces,
969             'c=' . ahm_describe($recce, $link_ahm_id) . q{@}
970             . $middle_earleme . q{-}
971             . $current_earleme;
972 236         1270 return '[' . ( join '; ', @pieces ) . ']';
973             } ## end sub Marpa::R2::show_completion_link_choice
974              
975             # Assumes trace completion source link set by caller
976             sub Marpa::R2::show_leo_link_choice {
977 27     27 0 52 my ( $recce, $link_ahm_id, $current_earleme ) = @_;
978 27         49 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
979 27         41 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
980 27         41 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
981 27         39 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
982 27         38 my $text = q{};
983 27         42 my @pieces = ();
984 27         60 my $middle_set_id = $recce_c->_marpa_r_source_middle();
985 27         69 my $middle_earleme = $recce_c->earleme($middle_set_id);
986 27         56 my $leo_transition_symbol =
987             $recce_c->_marpa_r_source_leo_transition_symbol();
988 27         67 push @pieces, 'l=L' . $leo_transition_symbol . q{@} . $middle_earleme;
989 27         65 push @pieces,
990             'c=' . ahm_describe($recce, $link_ahm_id)
991             . q{@}
992             . $middle_earleme . q{-}
993             . $current_earleme;
994 27         182 return '[' . ( join '; ', @pieces ) . ']';
995             } ## end sub Marpa::R2::show_leo_link_choice
996              
997             # Assumes trace earley item was set by caller
998             sub Marpa::R2::show_earley_item {
999 770     770 0 1281 my ( $recce, $current_es, $item_id ) = @_;
1000 770         1147 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
1001 770         1037 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
1002 770         1016 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1003 770         1032 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1004              
1005 770         1725 my $ahm_id_of_yim = $recce_c->_marpa_r_earley_item_trace($item_id);
1006 770 100       1449 return if not defined $ahm_id_of_yim;
1007              
1008 697         1001 my $text = q{};
1009 697         1313 my $origin_set_id = $recce_c->_marpa_r_earley_item_origin();
1010 697         1328 my $earleme = $recce_c->earleme($current_es);
1011 697         1240 my $origin_earleme = $recce_c->earleme($origin_set_id);
1012 697         1251 $text .= sprintf "ahm%d: %s@%d-%d", $ahm_id_of_yim,
1013             ahm_describe($recce, $ahm_id_of_yim),
1014             $origin_earleme, $earleme;
1015 697         1529 my @lines = $text;
1016 697         1445 my $irl_id = $grammar_c->_marpa_g_ahm_irl($ahm_id_of_yim);
1017 697         1264 my $dot_position = $grammar_c->_marpa_g_ahm_position($ahm_id_of_yim);
1018 697         1244 push @lines, qq{ }
1019             . ahm_describe($recce, $ahm_id_of_yim)
1020             . q{: }
1021             . $tracer->show_dotted_irl($irl_id, $dot_position);
1022 697         1216 my @sort_data = ();
1023              
1024 697         2238 for (
1025             my $symbol_id = $recce_c->_marpa_r_first_token_link_trace();
1026             defined $symbol_id;
1027             $symbol_id = $recce_c->_marpa_r_next_token_link_trace()
1028             )
1029             {
1030 101   50     494 push @sort_data,
1031             [
1032             $recce_c->_marpa_r_source_middle(),
1033             $symbol_id,
1034             ( $recce_c->_marpa_r_source_predecessor_state() // -1 ),
1035             Marpa::R2::show_token_link_choice( $recce, $earleme )
1036             ];
1037             } ## end for ( my $symbol_id = $recce_c->_marpa_r_first_token_link_trace...)
1038 101         307 my @pieces = map { $_->[-1] } sort {
1039 697 0 0     1415 $a->[0] <=> $b->[0]
  0         0  
1040             || $a->[1] <=> $b->[1]
1041             || $a->[2] <=> $b->[2]
1042             } @sort_data;
1043 697         1003 @sort_data = ();
1044 697         1859 for (
1045             my $cause_AHFA_id = $recce_c->_marpa_r_first_completion_link_trace();
1046             defined $cause_AHFA_id;
1047             $cause_AHFA_id = $recce_c->_marpa_r_next_completion_link_trace()
1048             )
1049             {
1050 236   50     912 push @sort_data,
1051             [
1052             $recce_c->_marpa_r_source_middle(),
1053             $cause_AHFA_id,
1054             ( $recce_c->_marpa_r_source_predecessor_state() // -1 ),
1055             Marpa::R2::show_completion_link_choice(
1056             $recce, $cause_AHFA_id, $earleme
1057             )
1058             ];
1059             } ## end for ( my $cause_AHFA_id = $recce_c...)
1060 236         548 push @pieces, map { $_->[-1] } sort {
1061 697 50 66     1317 $a->[0] <=> $b->[0]
  27         138  
1062             || $a->[1] <=> $b->[1]
1063             || $a->[2] <=> $b->[2]
1064             } @sort_data;
1065 697         1055 @sort_data = ();
1066 697         1723 for (
1067             my $link_ahm_id = $recce_c->_marpa_r_first_leo_link_trace();
1068             defined $link_ahm_id;
1069             $link_ahm_id = $recce_c->_marpa_r_next_leo_link_trace()
1070             )
1071             {
1072 27         97 push @sort_data,
1073             [
1074             $recce_c->_marpa_r_source_middle(),
1075             $link_ahm_id,
1076             $recce_c->_marpa_r_source_leo_transition_symbol(),
1077             Marpa::R2::show_leo_link_choice(
1078             $recce, $link_ahm_id, $earleme
1079             )
1080             ];
1081             } ## end for ( my $link_ahm_id = $recce_c...)
1082 27         70 push @pieces, map { $_->[-1] } sort {
1083 697 0 0     1093 $a->[0] <=> $b->[0]
  0         0  
1084             || $a->[1] <=> $b->[1]
1085             || $a->[2] <=> $b->[2]
1086             } @sort_data;
1087 697 100       1627 push @lines, q{ } . join q{ }, @pieces if @pieces;
1088 697         2543 return join "\n", @lines, q{};
1089             } ## end sub Marpa::R2::show_earley_item
1090              
1091             sub Marpa::R2::show_earley_set {
1092 81     81 0 160 my ( $recce, $traced_set_id ) = @_;
1093 81         140 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
1094 81         136 my $text = q{};
1095 81         116 my @sorted_data = ();
1096 81 100       336 if ( not defined $recce_c->_marpa_r_earley_set_trace($traced_set_id) ) {
1097 8         51 return $text;
1098             }
1099 73         131 EARLEY_ITEM: for ( my $item_id = 0;; $item_id++ ) {
1100 770         1470 my $item_desc = Marpa::R2::show_earley_item( $recce, $traced_set_id, $item_id );
1101 770 100       1595 last EARLEY_ITEM if not defined $item_desc;
1102             # We do not sort these any more
1103 697         1230 push @sorted_data, $item_desc;
1104             } ## end EARLEY_ITEM: for ( my $item_id = 0;; $item_id++ )
1105 73         113 my @sort_data = ();
1106             POSTDOT_ITEM:
1107 73         317 for (
1108             my $postdot_symbol_id = $recce_c->_marpa_r_first_postdot_item_trace();
1109             defined $postdot_symbol_id;
1110             $postdot_symbol_id = $recce_c->_marpa_r_next_postdot_item_trace()
1111             )
1112             {
1113              
1114             # If there is no base Earley item,
1115             # then this is not a Leo item, so we skip it
1116 670         1089 my $leo_item_desc = Marpa::R2::show_lim($recce);
1117 670 100       2019 next POSTDOT_ITEM if not defined $leo_item_desc;
1118 188         650 push @sort_data, [ $postdot_symbol_id, $leo_item_desc ];
1119             } ## end POSTDOT_ITEM: for ( my $postdot_symbol_id = $recce_c...)
1120             push @sorted_data, join q{},
1121 73         241 map { $_->[-1] . "\n" } sort { $a->[0] <=> $b->[0] } @sort_data;
  188         440  
  360         535  
1122 73         420 return join q{}, @sorted_data;
1123             } ## end sub Marpa::R2::show_earley_set
1124              
1125             sub Marpa::R2::Recognizer::show_earley_sets {
1126 8     8 0 2552 my ($recce) = @_;
1127 8         22 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
1128 8         78 my $last_completed_earleme = $recce_c->current_earleme();
1129 8         38 my $furthest_earleme = $recce_c->furthest_earleme();
1130 8         53 my $text = "Last Completed: $last_completed_earleme; "
1131             . "Furthest: $furthest_earleme\n";
1132 8         25 LIST: for ( my $ix = 0;; $ix++ ) {
1133 81         203 my $set_desc = Marpa::R2::show_earley_set( $recce, $ix );
1134 81 100       219 last LIST if not $set_desc;
1135 73         535 $text .= "Earley Set $ix\n$set_desc";
1136             }
1137 8         132 return $text;
1138             } ## end sub Marpa::R2::Recognizer::show_earley_sets
1139              
1140             1;
1141              
1142             # vim: set expandtab shiftwidth=4: