File Coverage

blib/lib/Marpa/R2/SLR.pm
Criterion Covered Total %
statement 695 855 81.2
branch 180 288 62.5
condition 50 96 52.0
subroutine 57 68 83.8
pod n/a
total 982 1307 75.1


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::Scanless::R;
17              
18 132     132   2635 use 5.010001;
  132         549  
19 132     132   875 use strict;
  132         349  
  132         2924  
20 132     132   748 use warnings;
  132         353  
  132         4436  
21              
22 132     132   869 use vars qw($VERSION $STRING_VERSION);
  132         368  
  132         11723  
23             $VERSION = '12.000000';
24             $STRING_VERSION = $VERSION;
25             ## no critic(BuiltinFunctions::ProhibitStringyEval)
26             $VERSION = eval $VERSION;
27             ## use critic
28              
29             package Marpa::R2::Internal::Scanless::R;
30              
31 132     132   937 use Scalar::Util 'blessed';
  132         342  
  132         7622  
32 132     132   984 use English qw( -no_match_vars );
  132         437  
  132         1034  
33              
34             our $PACKAGE = 'Marpa::R2::Scanless::R';
35             our $TRACE_FILE_HANDLE;
36              
37             sub Marpa::R2::Scanless::R::last_completed_range {
38 43     43   693 my ( $self, $symbol_name ) = @_;
39 43         133 my ( $start, $length ) = $self->last_completed($symbol_name);
40 43 100       135 return if not defined $start;
41 31         52 my $end = $start + $length;
42 31         87 return ( $start, $end );
43             } ## end sub Marpa::R2::Scanless::R::last_completed_range
44              
45             # Given a scanless
46             # recognizer and a symbol,
47             # return the start earley set
48             # and length
49             # of the last such symbol completed,
50             # undef if there was none.
51             sub Marpa::R2::Scanless::R::last_completed {
52 86     86   176 my ( $slr, $symbol_name ) = @_;
53 86         167 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
54 86         137 my $thick_g1_grammar =
55             $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
56 86         140 my $thick_g1_recce =
57             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
58 86         238 my $thin_g1_recce = $thick_g1_recce->thin();
59             my $sought_rules =
60             $slg->[Marpa::R2::Internal::Scanless::G::CACHE_RULEIDS_BY_LHS_NAME]
61 86         183 ->{$symbol_name};
62 86 100       218 if ( not defined $sought_rules ) {
63 25         87 my $g1_tracer = $thick_g1_grammar->tracer();
64 25         132 my $thin_g1_grammar = $thick_g1_grammar->thin();
65 25         127 my $symbol_id = $g1_tracer->symbol_by_name($symbol_name);
66 25 50       114 Marpa::R2::exception("Bad symbol in last_completed(): $symbol_name")
67             if not defined $symbol_id;
68             $sought_rules =
69             $slg->[Marpa::R2::Internal::Scanless::G::CACHE_RULEIDS_BY_LHS_NAME]
70             ->{$symbol_name} =
71 25         172 [ grep { $thin_g1_grammar->rule_lhs($_) == $symbol_id; }
  125         405  
72             0 .. $thin_g1_grammar->highest_rule_id() ];
73             Marpa::R2::exception(
74             "Looking for completion of non-existent rule lhs: $symbol_name")
75 25 50       57 if not scalar @{$sought_rules};
  25         94  
76             } ## end if ( not defined $sought_rules )
77 86         253 my $latest_earley_set = $thin_g1_recce->latest_earley_set();
78 86         161 my $earley_set = $latest_earley_set;
79              
80             # Initialize to one past the end, so we can tell if there were no hits
81 86         148 my $first_origin = $latest_earley_set + 1;
82 86         216 EARLEY_SET: while ( $earley_set >= 0 ) {
83 151         629 $thin_g1_recce->progress_report_start($earley_set);
84 151         206 ITEM: while (1) {
85 999         2031 my ( $rule_id, $dot_position, $origin ) =
86             $thin_g1_recce->progress_item();
87 999 100       1729 last ITEM if not defined $rule_id;
88 848 100       1475 next ITEM if $dot_position != -1;
89 326 100       391 next ITEM if not scalar grep { $_ == $rule_id } @{$sought_rules};
  476         1097  
  326         495  
90 76 50       206 next ITEM if $origin >= $first_origin;
91 76         122 $first_origin = $origin;
92             } ## end ITEM: while (1)
93 151         475 $thin_g1_recce->progress_report_finish();
94 151 100       319 last EARLEY_SET if $first_origin <= $latest_earley_set;
95 77         143 $earley_set--;
96             } ## end EARLEY_SET: while ( $earley_set >= 0 )
97 86 100       256 return if $earley_set < 0;
98 74         184 return ( $first_origin, ( $earley_set - $first_origin ) );
99             } ## end sub Marpa::R2::Scanless::R::last_completed
100              
101             # Returns most input stream span for symbol.
102             # If more than one ends at the same location,
103             # returns the longest.
104             # Returns under if there is no such span.
105             # Other failure is thrown.
106             sub Marpa::R2::Scanless::R::last_completed_span {
107 43     43   282 my ( $slr, $symbol_name ) = @_;
108 43         447 my ($g1_origin, $g1_span) = $slr->last_completed( $symbol_name );
109 43 50       88 return if not defined $g1_origin;
110 43         110 my ($start_input_location) = $slr->g1_location_to_span($g1_origin + 1);
111 43         90 my @end_span = $slr->g1_location_to_span($g1_origin + $g1_span);
112 43         120 return ($start_input_location, ($end_span[0]+$end_span[1])-$start_input_location);
113             }
114              
115             # In terms of earley sets.
116             # Kept for backward compatibiity
117             sub Marpa::R2::Scanless::R::range_to_string {
118 31     31   211 my ( $self, $start_earley_set, $end_earley_set ) = @_;
119 31         96 return $self->substring( $start_earley_set,
120             $end_earley_set - $start_earley_set );
121             }
122              
123             # Not documented. Should I?
124             sub Marpa::R2::Scanless::R::es_to_input_span {
125 1498     1498   2451 my ( $slr, $start_earley_set, $length_in_parse_locations ) = @_;
126             return
127 1498 50 33     4949 if not defined $start_earley_set
128             or not defined $length_in_parse_locations;
129 1498         2319 my $thick_g1_recce =
130             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
131 1498         4198 my $thin_g1_recce = $thick_g1_recce->thin();
132 1498         3412 my $latest_earley_set = $thin_g1_recce->latest_earley_set();
133              
134 1498         2225 my $earley_set_for_first_position = $start_earley_set + 1;
135 1498         2052 my $earley_set_for_last_position =
136             $start_earley_set + $length_in_parse_locations;
137              
138 1498 50       2875 die 'Error in $slr->substring(',
139             "$start_earley_set, $length_in_parse_locations", '): ',
140             "start ($start_earley_set) is at or after latest_earley_set ($latest_earley_set)"
141             if $earley_set_for_first_position > $latest_earley_set;
142 1498 50       2559 die 'Error in $slr->substring(',
143             "$start_earley_set, $length_in_parse_locations", '): ',
144             "end ( $start_earley_set + $length_in_parse_locations ) is after latest_earley_set ($latest_earley_set)"
145             if $earley_set_for_last_position > $latest_earley_set;
146              
147 1498         2089 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
148 1498         3645 my ($first_start_position) =
149             $thin_slr->span($earley_set_for_first_position);
150 1498         3205 my ( $last_start_position, $last_length ) =
151             $thin_slr->span($earley_set_for_last_position);
152 1498         2487 my $length_in_characters =
153             ( $last_start_position + $last_length ) - $first_start_position;
154              
155             # Negative lengths are quite possible if the application has jumped around in
156             # the input.
157 1498 50       2547 $length_in_characters = 0 if $length_in_characters <= 0;
158 1498         3152 return ( $first_start_position, $length_in_characters );
159              
160             } ## end sub Marpa::R2::Scanless::R::es_to_input_span
161              
162             # Substring in terms of earley sets.
163             # Necessary for the use of show_progress()
164             # Given a scanless recognizer and
165             # and two earley sets, return the input string
166             sub Marpa::R2::Scanless::R::substring {
167 1435     1435   4444 my ( $slr, $start_earley_set, $length_in_parse_locations ) = @_;
168 1435         2643 my ( $first_start_position, $length_in_characters ) =
169             $slr->es_to_input_span( $start_earley_set,
170             $length_in_parse_locations );
171 1435         2240 my $p_input = $slr->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING];
172 1435         1749 return substr ${$p_input}, $first_start_position, $length_in_characters;
  1435         6164  
173             } ## end sub Marpa::R2::Scanless::R::substring
174              
175             sub Marpa::R2::Scanless::R::g1_location_to_span {
176 210     210   1048 my ( $self, $g1_location ) = @_;
177 210         324 my $thin_self = $self->[Marpa::R2::Internal::Scanless::R::C];
178 210         667 return $thin_self->span($g1_location);
179             }
180              
181             # Substring in terms of locations in the input stream
182             # This is the one users will be most interested in.
183             sub Marpa::R2::Scanless::R::literal {
184 181     181   819 my ( $slr, $start_pos, $length ) = @_;
185 181         284 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
186 181         611 return $thin_slr->substring( $start_pos, $length );
187             } ## end sub Marpa::R2::Scanless::R::literal
188              
189             sub Marpa::R2::Internal::Scanless::meta_recce {
190 203     203   601 my ($hash_args) = @_;
191 203         568 state $meta_grammar = Marpa::R2::Internal::Scanless::meta_grammar();
192 203         712 $hash_args->{grammar} = $meta_grammar;
193 203         1313 my $self = Marpa::R2::Scanless::R->new($hash_args);
194 203         1271 return $self;
195             } ## end sub Marpa::R2::Internal::Scanless::meta_recce
196              
197             # For error messages, make it convenient to use an SLR
198             sub Marpa::R2::Scanless::R::rule_show {
199 1     1   7 my ( $slr, $rule_id ) = @_;
200 1         3 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
201 1         6 return $slg->rule_show($rule_id);
202             }
203              
204             sub Marpa::R2::Scanless::R::new {
205 957     957   274178 my ( $class, @args ) = @_;
206              
207 957         2057 my $slr = [];
208 957         2060 bless $slr, $class;
209              
210             # Set SLIF (not NAIF) recognizer args to default
211 957         3056 $slr->[Marpa::R2::Internal::Scanless::R::EXHAUSTION_ACTION] = 'fatal';
212 957         2220 $slr->[Marpa::R2::Internal::Scanless::R::REJECTION_ACTION] = 'fatal';
213 957         1903 $slr->[Marpa::R2::Internal::Scanless::R::TRACE_LEXERS] = 0;
214 957         1635 $slr->[Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS] = 0;
215              
216 957         2887 my ($g1_recce_args, $flat_args) =
217             Marpa::R2::Internal::Scanless::R::set( $slr, "new", @args );
218 957         1971 my $too_many_earley_items = $g1_recce_args->{too_many_earley_items};
219              
220 957         1671 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
221              
222 957 50       2171 Marpa::R2::exception(
223             qq{Marpa::R2::Scanless::R::new() called without a "grammar" argument}
224             ) if not defined $slg;
225              
226 957         1611 my $slg_class = 'Marpa::R2::Scanless::G';
227 957 50 33     8814 if ( not blessed $slg or not $slg->isa($slg_class) ) {
228 0         0 my $ref_type = ref $slg;
229 0 0       0 my $desc = $ref_type ? "a ref to $ref_type" : 'not a ref';
230 0         0 Marpa::R2::exception(
231             qq{'grammar' named argument to new() is $desc\n},
232             " It should be a ref to $slg_class\n" );
233             } ## end if ( not blessed $slg or not $slg->isa($slg_class) )
234              
235 957         2332 my $thick_g1_grammar =
236             $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
237              
238 957         1737 my $trace_file_handle = $g1_recce_args->{trace_file_handle};
239 957   66     5701 $trace_file_handle //= $thick_g1_grammar->[Marpa::R2::Internal::Grammar::TRACE_FILE_HANDLE] ;
240              
241 957         2934 my $thick_g1_recce =
242             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE] = bless [],
243             'Marpa::R2::Recognizer';
244              
245 957         3569 local $Marpa::R2::Internal::TRACE_FH =
246             $thick_g1_recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE] = $trace_file_handle;
247              
248 957         1671 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::GRAMMAR] = $thick_g1_grammar;
249              
250 957         1549 my $grammar_c = $thick_g1_grammar->[Marpa::R2::Internal::Grammar::C];
251              
252 957         14543 my $recce_c = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::C] =
253             Marpa::R2::Thin::R->new($grammar_c);
254 957 50       2992 if ( not defined $recce_c ) {
255 0         0 Marpa::R2::exception( $grammar_c->error() );
256             }
257              
258 957         3235 $recce_c->ruby_slippers_set(1);
259              
260 957 50 66     5958 if ( defined $thick_g1_grammar->[Marpa::R2::Internal::Grammar::ACTION_OBJECT]
      66        
261             or defined $thick_g1_grammar->[Marpa::R2::Internal::Grammar::ACTIONS]
262             or not defined $thick_g1_grammar->[Marpa::R2::Internal::Grammar::INTERNAL] )
263             {
264 1         3 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::RESOLVE_PACKAGE_SOURCE] =
265             'legacy';
266             } ## end if ( defined $grammar->[...])
267              
268 957 50       2673 if ( defined( my $value = $g1_recce_args->{'leo'} ) ) {
269 0 0       0 my $boolean = $value ? 1 : 0;
270 0         0 $thick_g1_recce->use_leo_set($boolean);
271 0         0 delete $g1_recce_args->{leo};
272             }
273              
274 957         2411 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::WARNINGS] = 1;
275 957         1844 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::RANKING_METHOD] = 'none';
276 957         1555 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::MAX_PARSES] = 0;
277 957         1558 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS] = 0;
278              
279             # Position 0 is not used because 0 indicates an unvalued token.
280             # Position 1 is reserved for undef.
281             # Position 2 is reserved for literal tokens (used in SLIF).
282 957         2110 $thick_g1_recce->[Marpa::R2::Internal::Recognizer::TOKEN_VALUES] = [undef, undef, undef];
283              
284 957         4550 $thick_g1_recce->reset_evaluation();
285              
286 957         2986 my $thin_slr =
287             Marpa::R2::Thin::SLR->new( $slg->[Marpa::R2::Internal::Scanless::G::C],
288             $thick_g1_recce->thin() );
289 957 100       2653 $thin_slr->earley_item_warning_threshold_set($too_many_earley_items)
290             if defined $too_many_earley_items;
291 957         1666 $slr->[Marpa::R2::Internal::Scanless::R::C] = $thin_slr;
292 957         2120 $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] = [];
293              
294 957         1772 my $symbol_ids_by_event_name_and_type =
295             $slg->[
296             Marpa::R2::Internal::Scanless::G::SYMBOL_IDS_BY_EVENT_NAME_AND_TYPE];
297              
298 957   100     3485 my $event_is_active_arg = $flat_args->{event_is_active} // {};
299 957 50       2885 if (ref $event_is_active_arg ne 'HASH') {
300 0         0 Marpa::R2::exception( 'event_is_active named argument must be ref to hash' );
301             }
302              
303             # Completion/nulled/prediction events are always initialized by
304             # Libmarpa to 'on'. So here we need to override that if and only
305             # if we in fact want to initialize them to 'off'.
306              
307             # Events are already initialized as described by
308             # the DSL. Here we override that with the recce arg, if
309             # necessary.
310            
311 957         1520 EVENT: for my $event_name ( keys %{$event_is_active_arg} ) {
  957         3055  
312              
313 470         748 my $is_active = $event_is_active_arg->{$event_name};
314              
315             my $symbol_ids =
316 470         745 $symbol_ids_by_event_name_and_type->{$event_name}->{lexeme};
317             $thin_slr->lexeme_event_activate( $_, $is_active )
318 470         624 for @{$symbol_ids};
  470         979  
319             my $lexer_rule_ids =
320 470         757 $symbol_ids_by_event_name_and_type->{$event_name}->{discard};
321             $thin_slr->discard_event_activate( $_, $is_active )
322 470         591 for @{$lexer_rule_ids};
  470         1266  
323              
324             $symbol_ids =
325             $symbol_ids_by_event_name_and_type->{$event_name}->{completion}
326 470   100     1575 // [];
327             $recce_c->completion_symbol_activate( $_, $is_active )
328 470         709 for @{$symbol_ids};
  470         858  
329             $symbol_ids =
330 470   100     1264 $symbol_ids_by_event_name_and_type->{$event_name}->{nulled} // [];
331 470         663 $recce_c->nulled_symbol_activate( $_, $is_active ) for @{$symbol_ids};
  470         768  
332             $symbol_ids =
333             $symbol_ids_by_event_name_and_type->{$event_name}->{prediction}
334 470   100     1209 // [];
335             $recce_c->prediction_symbol_activate( $_, $is_active )
336 470         625 for @{$symbol_ids};
  470         1018  
337             } ## end EVENT: for my $event_name ( keys %{$event_is_active_arg} )
338              
339 957 50       13324 if ( not $recce_c->start_input() ) {
340 0         0 my $error = $grammar_c->error();
341 0         0 Marpa::R2::exception( 'Recognizer start of input failed: ', $error );
342             }
343              
344 957         4167 $thick_g1_recce->set($g1_recce_args);
345              
346 957 100       2565 if ( $thick_g1_recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS] > 1 ) {
347 1         2 my @terminals_expected = @{ $thick_g1_recce->terminals_expected() };
  1         7  
348 1         7 for my $terminal ( sort @terminals_expected ) {
349 3 50       5 say {$Marpa::R2::Internal::TRACE_FH}
  3         18  
350             qq{Expecting "$terminal" at earleme 0}
351             or Marpa::R2::exception("Cannot print: $ERRNO");
352             }
353             } ## end if ( $thick_g1_recce->[Marpa::R2::Internal::Recognizer::TRACE_TERMINALS...])
354              
355 957         3247 Marpa::R2::Internal::Scanless::convert_libmarpa_events($slr);
356              
357 957         6061 return $slr;
358             } ## end sub Marpa::R2::Scanless::R::new
359              
360             sub Marpa::R2::Scanless::R::set {
361 11     11   131 my ( $slr, @args ) = @_;
362 11         26 my $naif_recce_args =
363             Marpa::R2::Internal::Scanless::R::set( $slr, "set", @args );
364 11         35 my $naif_recce = $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
365 11         38 $naif_recce->set($naif_recce_args);
366 11         30 return $slr;
367             } ## end sub Marpa::R2::Scanless::R::set
368              
369             # The context flag indicates whether this set is called directly by the user
370             # or is for series reset or the constructor. "Context" flags of this kind
371             # are much decried practice, and for good reason, but in this case
372             # I think it is justified.
373             # This logic really needs to be all in one place, and so a flag
374             # to trigger the minor differences needed by the various calling
375             # contexts is a small price to pay.
376             sub Marpa::R2::Internal::Scanless::R::set {
377              
378 1024     1024   2607 my ( $slr, $method, @hash_ref_args ) = @_;
379              
380             # These NAIF recce args are allowed in all contexts
381             state $common_naif_recce_args = {
382 1024         1918 map { ( $_, 1 ); }
  576         1773  
383             qw(end max_parses semantics_package too_many_earley_items
384             trace_actions trace_file_handle trace_terminals trace_values)
385             };
386             state $common_slif_recce_args =
387 1024         1730 { map { ( $_, 1 ); } qw(trace_lexers rejection exhaustion) };
  216         692  
388             state $set_method_args = {
389 792         1521 map { ( $_, 1 ); } (
390 72         315 keys %{$common_slif_recce_args},
391 1024         1557 keys %{$common_naif_recce_args}
  72         332  
392             )
393             };
394             state $new_method_args = {
395 1008         1961 map { ( $_, 1 ); } qw(grammar ranking_method event_is_active),
396 1024         1939 keys %{$set_method_args}
  72         382  
397             };
398             state $series_restart_method_args = {
399 792         1448 map { ( $_, 1 ); } (
400 72         238 keys %{$common_slif_recce_args},
401 1024         1887 keys %{$common_naif_recce_args}
  72         266  
402             )
403             };
404              
405 1024         2489 for my $args (@hash_ref_args) {
406 1396         2605 my $ref_type = ref $args;
407 1396 50       3040 if ( not $ref_type ) {
408 0         0 Marpa::R2::exception( q{$slr->}
409             . $method
410             . qq{() expects args as ref to HASH; got non-reference instead}
411             );
412             } ## end if ( not $ref_type )
413 1396 50       3729 if ( $ref_type ne 'HASH' ) {
414 0         0 Marpa::R2::exception( q{$slr->}
415             . $method
416             . qq{() expects args as ref to HASH, got ref to $ref_type instead}
417             );
418             } ## end if ( $ref_type ne 'HASH' )
419             } ## end for my $args (@hash_ref_args)
420              
421 1024         1980 my %flat_args = ();
422 1024         1867 for my $hash_ref (@hash_ref_args) {
423 1396         1953 ARG: for my $arg_name ( keys %{$hash_ref} ) {
  1396         3899  
424 1548         4190 $flat_args{$arg_name} = $hash_ref->{$arg_name};
425             }
426             }
427 1024         1729 my $ok_args = $set_method_args;
428 1024 100       2691 $ok_args = $new_method_args if $method eq 'new';
429 1024 100       2218 $ok_args = $series_restart_method_args if $method eq 'series_restart';
430 1024         2742 my @bad_args = grep { not $ok_args->{$_} } keys %flat_args;
  1548         4467  
431 1024 50       2716 if ( scalar @bad_args ) {
432 0         0 Marpa::R2::exception(
433             q{Bad named argument(s) to $slr->}
434             . $method
435             . q{() method: }
436             . join q{ },
437             @bad_args
438             );
439             } ## end if ( scalar @bad_args )
440              
441             # Special SLIF (not NAIF) recce arg processing goes here
442 1024 100       2743 if ( exists $flat_args{'exhaustion'} ) {
443              
444 26         41 state $exhaustion_actions = { map { ( $_, 0 ) } qw(fatal event) };
  2         7  
445 26   50     61 my $value = $flat_args{'exhaustion'} // 'undefined';
446             Marpa::R2::exception(
447             qq{'exhaustion' named arg value is $value (should be one of },
448             ( join q{, },
449 0         0 map { q{'} . $_ . q{'} } keys %{$exhaustion_actions}
  0         0  
450             ),
451             ')'
452 26 50       60 ) if not exists $exhaustion_actions->{$value};
453 26         49 $slr->[Marpa::R2::Internal::Scanless::R::EXHAUSTION_ACTION] = $value;
454              
455             } ## end if ( exists $flat_args{'exhaustion'} )
456              
457             # Special SLIF (not NAIF) recce arg processing goes here
458 1024 100       2485 if ( exists $flat_args{'rejection'} ) {
459              
460 20         29 state $rejection_actions = { map { ( $_, 0 ) } qw(fatal event) };
  6         29  
461 20   50     53 my $value = $flat_args{'rejection'} // 'undefined';
462             Marpa::R2::exception(
463             qq{'rejection' named arg value is $value (should be one of },
464             ( join q{, },
465 0         0 map { q{'} . $_ . q{'} } keys %{$rejection_actions}
  0         0  
466             ),
467             ')'
468 20 50       51 ) if not exists $rejection_actions->{$value};
469 20         38 $slr->[Marpa::R2::Internal::Scanless::R::REJECTION_ACTION] = $value;
470              
471             } ## end if ( exists $flat_args{'rejection'} )
472              
473             # A bit hack-ish, but some named args are copies straight to an member of
474             # the Scanless::R class, so this maps named args to the index of the array
475             # that holds the members.
476 1024         1960 state $copy_arg_to_index = {
477             trace_file_handle =>
478             Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE,
479             trace_lexers => Marpa::R2::Internal::Scanless::R::TRACE_LEXERS,
480             trace_terminals => Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS,
481             grammar => Marpa::R2::Internal::Scanless::R::GRAMMAR,
482             };
483              
484 1024         2280 ARG: for my $arg_name ( keys %flat_args ) {
485 1548         2523 my $index = $copy_arg_to_index->{$arg_name};
486 1548 100       3575 next ARG if not defined $index;
487 960         1733 my $value = $flat_args{$arg_name};
488 960         2160 $slr->[$index] = $value;
489             } ## end ARG: for my $arg_name ( keys %flat_args )
490              
491             # Normalize trace levels to numbers
492 1024         2149 for my $trace_level_arg (
493             Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS,
494             Marpa::R2::Internal::Scanless::R::TRACE_LEXERS
495             )
496             {
497 2048 50       6357 $slr->[$trace_level_arg] = 0
498             if
499             not Scalar::Util::looks_like_number( $slr->[$trace_level_arg] );
500             } ## end for my $trace_level_arg ( ...)
501              
502             # Trace file handle can never be undefined
503 1024 100       2669 if (not defined $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE] )
504             {
505 956         1632 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
506 956         1900 $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE] =
507             $slg->[Marpa::R2::Internal::Scanless::G::TRACE_FILE_HANDLE];
508             } ## end if ( not defined $slr->[...])
509              
510             # These NAIF recce args, when applicable, are simply copies of the the
511             # SLIF args of the same name
512             state $copyable_naif_recce_args = {
513 1024         1710 map { ( $_, 1 ); }
  648         1371  
514             qw(end max_parses semantics_package too_many_earley_items ranking_method
515             trace_actions trace_file_handle trace_terminals trace_values)
516             };
517              
518             # Prune flat args of all those named args which are NOT to be copied
519             # into the NAIF recce args
520 1024         1878 my %g1_recce_args = ();
521 1024         2067 for my $arg_name ( grep { $copyable_naif_recce_args->{$_} }
  1548         3443  
522             keys %flat_args )
523             {
524 237         601 $g1_recce_args{$arg_name} = $flat_args{$arg_name};
525             }
526              
527 1024         3671 return \%g1_recce_args, \%flat_args;
528              
529             } ## end sub Marpa::R2::Internal::Scanless::R::set
530              
531             sub Marpa::R2::Scanless::R::thin {
532 1509     1509   5939 return $_[0]->[Marpa::R2::Internal::Scanless::R::C];
533             }
534              
535             sub Marpa::R2::Scanless::R::trace {
536 0     0   0 my ( $self, $level ) = @_;
537 0         0 my $thin_slr = $self->[Marpa::R2::Internal::Scanless::R::C];
538 0   0     0 $level //= 1;
539 0         0 return $thin_slr->trace($level);
540             } ## end sub Marpa::R2::Scanless::R::trace
541              
542             sub Marpa::R2::Scanless::R::error {
543 0     0   0 my ($self) = @_;
544 0         0 return $self->[Marpa::R2::Internal::Scanless::R::READ_STRING_ERROR];
545             }
546              
547             sub Marpa::R2::Scanless::R::read {
548 957     957   6048 my ( $self, $p_string, $start_pos, $length ) = @_;
549              
550 957   100     4072 $start_pos //= 0;
551 957   100     3562 $length //= -1;
552 957 50       3989 Marpa::R2::exception(
553             "Multiple read()'s tried on a scannerless recognizer\n",
554             ' Currently the string cannot be changed once set'
555             ) if defined $self->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING];
556              
557 957 50       3179 if ( ( my $ref_type = ref $p_string ) ne 'SCALAR' ) {
558 0 0       0 my $desc = $ref_type ? "a ref to $ref_type" : 'not a ref';
559 0         0 Marpa::R2::exception(
560             qq{Arg to Marpa::R2::Scanless::R::read() is $desc\n},
561             ' It should be a ref to scalar' );
562             } ## end if ( ( my $ref_type = ref $p_string ) ne 'SCALAR' )
563              
564 957 50       1532 if ( not defined ${$p_string} ) {
  957         2543  
565 0         0 Marpa::R2::exception(
566             qq{Arg to Marpa::R2::Scanless::R::read() is a ref to an undef\n},
567             ' It should be a ref to a defined scalar' );
568             } ## end if ( ( my $ref_type = ref $p_string ) ne 'SCALAR' )
569              
570 957         1840 $self->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING] = $p_string;
571              
572 957         1655 my $thin_slr = $self->[Marpa::R2::Internal::Scanless::R::C];
573 957         1557 my $trace_terminals = $self->[Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS];
574 957         1497 my $trace_lexers = $self->[Marpa::R2::Internal::Scanless::R::TRACE_LEXERS];
575 957 100       1983 $thin_slr->trace_terminals($trace_terminals) if $trace_terminals;
576 957 50       1946 $thin_slr->trace_lexers($trace_lexers) if $trace_lexers;
577              
578 957         6846 $thin_slr->string_set($p_string);
579              
580 956 100       1488 return 0 if @{ $self->[Marpa::R2::Internal::Scanless::R::EVENTS] };
  956         2665  
581              
582 925         2917 return $self->resume( $start_pos, $length );
583              
584             } ## end sub Marpa::R2::Scanless::R::read
585              
586             my $libmarpa_trace_event_handlers = {
587              
588             'g1 accepted lexeme' => sub {
589             my ( $slr, $event ) = @_;
590             my ( undef, undef, $lexeme_start_pos, $lexeme_end_pos, $g1_lexeme)
591             = @{$event};
592             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
593             my $raw_token_value =
594             $thin_slr->substring( $lexeme_start_pos,
595             $lexeme_end_pos - $lexeme_start_pos );
596             my $trace_file_handle =
597             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
598             my $thick_g1_recce =
599             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
600             my $thick_g1_grammar = $thick_g1_recce->grammar();
601             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
602             say {$trace_file_handle} qq{Accepted lexeme },
603             input_range_describe( $slr, $lexeme_start_pos,
604             $lexeme_end_pos - 1 ),
605             q{ e}, $slr->current_g1_location(),
606             q{: },
607             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
608             qq{; value="$raw_token_value"}
609             or Marpa::R2::exception("Could not say(): $ERRNO");
610             },
611             'rejected lexeme' => sub {
612             my ( $slr, $event ) = @_;
613             # Necessary to check, because this one can be returned when not tracing
614             return if not $slr->[Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS];
615             my ( undef, undef, $lexeme_start_pos, $lexeme_end_pos, $g1_lexeme)
616             = @{$event};
617             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
618             my $raw_token_value =
619             $thin_slr->substring( $lexeme_start_pos,
620             $lexeme_end_pos - $lexeme_start_pos );
621             my $trace_file_handle =
622             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
623             my $thick_g1_recce =
624             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
625             my $thick_g1_grammar = $thick_g1_recce->grammar();
626             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
627             say {$trace_file_handle} qq{Rejected lexeme },
628             input_range_describe( $slr, $lexeme_start_pos,
629             $lexeme_end_pos - 1 ),
630             q{: },
631             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
632             qq{; value="$raw_token_value"}
633             or Marpa::R2::exception("Could not say(): $ERRNO");
634             },
635             'expected lexeme' => sub {
636             my ( $slr, $event ) = @_;
637             # Necessary to check, because this one can be returned when not tracing
638             return if not $slr->[Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS];
639             my ( undef, undef, $position, $g1_lexeme, $assertion_id)
640             = @{$event};
641             my ( $line, $column ) = $slr->line_column($position);
642             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
643             my $trace_file_handle =
644             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
645             my $thick_g1_recce =
646             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
647             my $thick_g1_grammar = $thick_g1_recce->grammar();
648             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
649             say {$trace_file_handle} qq{Expected lexeme },
650             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
651             " at line $line, column $column; assertion ID = $assertion_id"
652             or Marpa::R2::exception("Could not say(): $ERRNO");
653             },
654             'outprioritized lexeme' => sub {
655             my ( $slr, $event ) = @_;
656             my ( undef, undef, $lexeme_start_pos, $lexeme_end_pos, $g1_lexeme,
657             $lexeme_priority, $required_priority )
658             = @{$event};
659             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
660             my $raw_token_value =
661             $thin_slr->substring( $lexeme_start_pos,
662             $lexeme_end_pos - $lexeme_start_pos );
663             my $trace_file_handle =
664             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
665             my $thick_g1_recce =
666             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
667             my $thick_g1_grammar = $thick_g1_recce->grammar();
668             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
669             say {$trace_file_handle}
670             qq{Outprioritized lexeme },
671             input_range_describe( $slr, $lexeme_start_pos,
672             $lexeme_end_pos - 1 ),
673             q{: },
674             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
675             qq{; value="$raw_token_value"; },
676             qq{priority was $lexeme_priority, but $required_priority was required}
677             or Marpa::R2::exception("Could not say(): $ERRNO");
678             },
679             'g1 duplicate lexeme' => sub {
680             my ( $slr, $event ) = @_;
681             my ( undef, undef, $lexeme_start_pos, $lexeme_end_pos, $g1_lexeme ) =
682             @{$event};
683             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
684             my $raw_token_value =
685             $thin_slr->substring( $lexeme_start_pos,
686             $lexeme_end_pos - $lexeme_start_pos );
687             my $trace_file_handle =
688             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
689             my $thick_g1_recce =
690             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
691             my $thick_g1_grammar = $thick_g1_recce->grammar();
692             say {$trace_file_handle}
693             'Rejected as duplicate lexeme ',
694             input_range_describe( $slr, $lexeme_start_pos,
695             $lexeme_end_pos - 1 ),
696             q{: },
697             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
698             qq{; value="$raw_token_value"}
699             or Marpa::R2::exception("Could not say(): $ERRNO");
700             },
701             'g1 attempting lexeme' => sub {
702             my ( $slr, $event ) = @_;
703             my ( undef, undef, $lexeme_start_pos, $lexeme_end_pos, $g1_lexeme ) =
704             @{$event};
705             my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
706             my $raw_token_value =
707             $thin_slr->substring( $lexeme_start_pos,
708             $lexeme_end_pos - $lexeme_start_pos );
709             my $trace_file_handle =
710             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
711             my $thick_g1_recce =
712             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
713             my $thick_g1_grammar = $thick_g1_recce->grammar();
714             say {$trace_file_handle}
715             'Attempting to read lexeme ',
716             input_range_describe( $slr, $lexeme_start_pos,
717             $lexeme_end_pos - 1 ),
718             q{ e}, $slr->current_g1_location(),
719             q{: },
720             $thick_g1_grammar->symbol_in_display_form($g1_lexeme),
721             qq{; value="$raw_token_value"}
722             or Marpa::R2::exception("Could not say(): $ERRNO");
723             },
724             'lexer reading codepoint' => sub {
725             my ( $slr, $event ) = @_;
726             my ( undef, undef, $codepoint, $position, ) = @{$event};
727             my $char = chr $codepoint;
728             my @char_desc = ();
729             push @char_desc, qq{"$char"}
730 131     131   721199 if $char =~ /[\p{IsGraph}]/xms;
  131         2225  
  131         2692  
731             push @char_desc, ( sprintf '0x%04x', $codepoint );
732             my $char_desc = join q{ }, @char_desc;
733             my ( $line, $column ) = $slr->line_column($position);
734             my $trace_file_handle =
735             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
736             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
737             say {$trace_file_handle}
738             qq{Reading codepoint $char_desc at line $line, column $column}
739             or Marpa::R2::exception("Could not say(): $ERRNO");
740             },
741             'lexer accepted codepoint' => sub {
742             my ( $slr, $event ) = @_;
743             my ( undef, undef, $codepoint, $position, $token_id ) =
744             @{$event};
745             my $char = chr $codepoint;
746             my @char_desc = ();
747             push @char_desc, qq{"$char"}
748             if $char =~ /[\p{IsGraph}]/xms;
749             push @char_desc, ( sprintf '0x%04x', $codepoint );
750             my $char_desc = join q{ }, @char_desc;
751             my $grammar = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
752             my $thick_lex_grammar =
753             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
754             ->[0];
755             my $symbol_in_display_form =
756             $thick_lex_grammar->symbol_in_display_form($token_id),
757             my ( $line, $column ) = $slr->line_column($position);
758             my $trace_file_handle =
759             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
760             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
761             say {$trace_file_handle}
762             qq{Codepoint $char_desc accepted as $symbol_in_display_form at line $line, column $column}
763             or Marpa::R2::exception("Could not say(): $ERRNO");
764             },
765             'lexer rejected codepoint' => sub {
766             my ( $slr, $event ) = @_;
767             my ( undef, undef, $codepoint, $position, $token_id ) =
768             @{$event};
769             my $char = chr $codepoint;
770             my @char_desc = ();
771             push @char_desc, qq{"$char"}
772             if $char =~ /[\p{IsGraph}]/xms;
773             push @char_desc, ( sprintf '0x%04x', $codepoint );
774             my $char_desc = join q{ }, @char_desc;
775             my $grammar = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
776             my $thick_lex_grammar =
777             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
778             ->[0];
779             my $symbol_in_display_form =
780             $thick_lex_grammar->symbol_in_display_form($token_id),
781             my ( $line, $column ) = $slr->line_column($position);
782             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
783             my $trace_file_handle =
784             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
785             say {$trace_file_handle}
786             qq{Codepoint $char_desc rejected as $symbol_in_display_form at line $line, column $column}
787             or Marpa::R2::exception("Could not say(): $ERRNO");
788             },
789             'lexer restarted recognizer' => sub {
790             my ( $slr, $event ) = @_;
791             my ( undef, undef, $position ) = @{$event};
792             my ( $line, $column ) = $slr->line_column($position);
793             my $trace_file_handle =
794             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
795             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
796             say {$trace_file_handle}
797             qq{Restarted recognizer at line $line, column $column}
798             or Marpa::R2::exception("Could not say(): $ERRNO");
799             },
800             'discarded lexeme' => sub {
801             my ( $slr, $event ) = @_;
802             my ( undef, undef, $lex_rule_id, $start, $end ) =
803             @{$event};
804             my $grammar = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
805             my $thick_lex_grammar =
806             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
807             ->[0];
808             my $grammar_c = $thick_lex_grammar->[Marpa::R2::Internal::Grammar::C];
809             my $rule_length = $grammar_c->rule_length($lex_rule_id);
810             my @rhs_ids =
811             map { $grammar_c->rule_rhs( $lex_rule_id, $_ ) }
812             ( 0 .. $rule_length - 1 );
813             my @rhs =
814             map { $thick_lex_grammar->symbol_in_display_form($_) } @rhs_ids;
815             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
816             my $trace_file_handle =
817             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
818             say {$trace_file_handle} qq{Discarded lexeme },
819             input_range_describe( $slr, $start, $end - 1 ), q{: }, join q{ },
820             @rhs
821             or Marpa::R2::exception("Could not say(): $ERRNO");
822             },
823             'g1 pausing before lexeme' => sub {
824             my ( $slr, $event ) = @_;
825             my ( undef, undef, $start, $end, $lexeme_id ) = @{$event};
826             my $thick_g1_recce =
827             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
828             my $thick_g1_grammar = $thick_g1_recce->grammar();
829             my $lexeme_name =
830             $thick_g1_grammar->symbol_in_display_form($lexeme_id);
831             my $trace_file_handle =
832             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
833             say {$trace_file_handle} 'Paused before lexeme ',
834             input_range_describe( $slr, $start, $end - 1 ), ": $lexeme_name"
835             or Marpa::R2::exception("Could not say(): $ERRNO");
836             },
837             'g1 pausing after lexeme' => sub {
838             my ( $slr, $event ) = @_;
839             my ( undef, undef, $start, $end, $lexeme_id ) = @{$event};
840             my $thick_g1_recce =
841             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
842             my $thick_g1_grammar = $thick_g1_recce->grammar();
843             my $lexeme_name =
844             $thick_g1_grammar->symbol_in_display_form($lexeme_id);
845             my $trace_file_handle =
846             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
847             say {$trace_file_handle} 'Paused after lexeme ',
848             input_range_describe( $slr, $start, $end - 1 ), ": $lexeme_name"
849             or Marpa::R2::exception("Could not say(): $ERRNO");
850             },
851             'ignored lexeme' => sub {
852             my ( $slr, $event ) = @_;
853             my ( undef, undef, $g1_symbol_id, $start, $end ) = @{$event};
854             my $thick_g1_recce =
855             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
856             my $thick_g1_grammar = $thick_g1_recce->grammar();
857             my $lexeme_name =
858             $thick_g1_grammar->symbol_in_display_form($g1_symbol_id);
859             my $trace_file_handle =
860             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
861             say {$trace_file_handle} 'Ignored lexeme ',
862             input_range_describe( $slr, $start, $end - 1 ), ": $lexeme_name"
863             or Marpa::R2::exception("Could not say(): $ERRNO");
864             },
865             };
866              
867             my $libmarpa_event_handlers = {
868             q{'trace} => sub {
869             my ( $slr, $event ) = @_;
870             my $handler = $libmarpa_trace_event_handlers->{ $event->[1] };
871             if ( defined $handler ) {
872             $handler->( $slr, $event );
873             }
874             else {
875             my $trace_file_handle =
876             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
877             say {$trace_file_handle} join q{ }, qw(Trace event:), @{$event}[1 .. $#{$event}]
878             or Marpa::R2::exception("Could not say(): $ERRNO");
879             } ## end else [ if ( defined $handler ) ]
880             return 0;
881             },
882              
883             'symbol completed' => sub {
884             my ( $slr, $event ) = @_;
885             my ( undef, $completed_symbol_id ) = @{$event};
886             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
887             my $completion_event_by_id =
888             $slg->[Marpa::R2::Internal::Scanless::G::COMPLETION_EVENT_BY_ID];
889             push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
890             [ $completion_event_by_id->[$completed_symbol_id] ];
891             return 1;
892             },
893              
894             'symbol nulled' => sub {
895             my ( $slr, $event ) = @_;
896             my ( undef, $nulled_symbol_id ) = @{$event};
897             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
898             my $nulled_event_by_id =
899             $slg->[Marpa::R2::Internal::Scanless::G::NULLED_EVENT_BY_ID];
900             push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
901             [ $nulled_event_by_id->[$nulled_symbol_id] ];
902             return 1;
903             },
904              
905             'symbol predicted' => sub {
906             my ( $slr, $event ) = @_;
907             my ( undef, $predicted_symbol_id ) = @{$event};
908             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
909             my $prediction_event_by_id =
910             $slg->[Marpa::R2::Internal::Scanless::G::PREDICTION_EVENT_BY_ID];
911             push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
912             [ $prediction_event_by_id->[$predicted_symbol_id] ];
913             return 1;
914             },
915              
916             # 'after lexeme' is same -- copied over below
917             'before lexeme' => sub {
918             my ( $slr, $event ) = @_;
919             my ( undef, $lexeme_id ) = @{$event};
920             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
921             my $lexeme_event =
922             $slg->[Marpa::R2::Internal::Scanless::G::LEXEME_EVENT_BY_ID]
923             ->[$lexeme_id];
924             push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
925             [$lexeme_event]
926             if defined $lexeme_event;
927             return 1;
928             },
929              
930             'discarded lexeme' => sub {
931             my ( $slr, $event ) = @_;
932             my ( undef, $rule_id, @other_data) = @{$event};
933             my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
934             my $lexeme_event =
935             $slg->[Marpa::R2::Internal::Scanless::G::DISCARD_EVENT_BY_LEXER_RULE]
936             ->[$rule_id];
937             push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
938             [$lexeme_event, @other_data]
939             if defined $lexeme_event;
940             return 1;
941             },
942              
943             'unknown g1 event' => sub {
944             my ( $slr, $event ) = @_;
945             Marpa::R2::exception( ( join q{ }, 'Unknown event:', @{$event} ) );
946             return 0;
947             },
948              
949             'no acceptable input' => sub {
950             ## Do nothing at this point
951             return 0;
952             },
953             };
954              
955             $libmarpa_event_handlers->{'after lexeme'} = $libmarpa_event_handlers->{'before lexeme'};
956              
957             # Return 1 if internal scanning should pause
958             sub Marpa::R2::Internal::Scanless::convert_libmarpa_events {
959 6333     6333   11506 my ($slr) = @_;
960 6333         9008 my $pause = 0;
961 6333         10229 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
962 6333         19977 EVENT: for my $event ( $thin_slr->events() ) {
963 1315         2313 my ($event_type) = @{$event};
  1315         2375  
964 1315         2635 my $handler = $libmarpa_event_handlers->{$event_type};
965 1315 50       2592 Marpa::R2::exception( ( join q{ }, 'Unknown event:', @{$event} ) )
  0         0  
966             if not defined $handler;
967 1315 100       2553 $pause = 1 if $handler->( $slr, $event );
968             } ## end EVENT: for my $event ( $thin_slr->events() )
969 6333         11940 return $pause;
970             } ## end sub Marpa::R2::Internal::Scanless::convert_libmarpa_events
971              
972             sub Marpa::R2::Scanless::R::resume {
973 1893     1893   10069 my ( $slr, $start_pos, $length ) = @_;
974 1893 50       4443 Marpa::R2::exception(
975             "Attempt to resume an SLIF recce which has no string set\n",
976             ' The string should be set first using read()'
977             )
978             if not defined $slr->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING];
979              
980 1893         3089 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
981 1893         2919 my $trace_terminals =
982             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_TERMINALS];
983 1893         2901 my $trace_lexers = $slr->[Marpa::R2::Internal::Scanless::R::TRACE_LEXERS];
984              
985 1893   100     9532 $thin_slr->pos_set( ($start_pos // $thin_slr->pos()), ($length // -1));
      100        
986 1893         4058 $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] = [];
987 1893         3097 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
988 1893         3080 my $thin_slg = $slg->[Marpa::R2::Internal::Scanless::G::C];
989              
990 1893         2741 OUTER_READ: while (1) {
991              
992 6025         767434 my $problem_code = $thin_slr->read();
993              
994 6025 100       19402 last OUTER_READ if not $problem_code;
995 5182         10620 my $pause =
996             Marpa::R2::Internal::Scanless::convert_libmarpa_events($slr);
997              
998 5182 50       11137 if ( $trace_lexers > 2 ) {
999 0         0 my $stream_pos = $thin_slr->pos();
1000 0         0 my $trace_file_handle =
1001             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
1002 0         0 my $thick_lex_grammar =
1003             $slg->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]->[0];
1004 0         0 my $lex_tracer = $thick_lex_grammar->tracer();
1005 0         0 my ( $line, $column ) = $slr->line_column($stream_pos);
1006 0 0       0 print {$trace_file_handle}
  0         0  
1007             qq{\n=== Progress report at line $line, column $column\n},
1008             $lex_tracer->lexer_progress_report($slr),
1009             qq{=== End of progress report at line $line, column $column\n},
1010             or Marpa::R2::exception("Cannot print(): $ERRNO");
1011             } ## end if ( $trace_lexers > 2 )
1012              
1013 5182 100       10121 last OUTER_READ if $pause;
1014 4171 100       8444 next OUTER_READ if $problem_code eq 'event';
1015 4140 50       7660 next OUTER_READ if $problem_code eq 'trace';
1016              
1017             # The event on exhaustion only occurs if needed to provide a reason
1018             # to return -- if an exhausted reader would return anyway, there is
1019             # no exhaustion event. For a reliable way to detect exhaustion,
1020             # use the $slr->exhausted() method.
1021             # The name of the exhausted event begins with a single quote, so
1022             # that it will not conflict with any user-defined event name.
1023              
1024 4140 100 100     8638 if ( $problem_code eq 'R1 exhausted before end'
1025             and $slr->[Marpa::R2::Internal::Scanless::R::EXHAUSTION_ACTION]
1026             eq 'event' )
1027             {
1028 8         12 push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
  8         23  
1029             [q{'exhausted}];
1030 8         19 last OUTER_READ;
1031             } ## end if ( $problem_code eq 'R1 exhausted before end' and ...)
1032              
1033 4132 100 100     8643 if ( $problem_code eq 'no lexeme'
1034             and $slr->[Marpa::R2::Internal::Scanless::R::REJECTION_ACTION]
1035             eq 'event' )
1036             {
1037 22         43 push @{ $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] },
  22         70  
1038             [q{'rejected}];
1039 22         49 last OUTER_READ;
1040             }
1041              
1042 4110 50       7435 if ( $problem_code eq 'invalid char' ) {
1043 0         0 my $codepoint = $thin_slr->codepoint();
1044 0         0 Marpa::R2::exception(
1045             qq{Failed at unacceptable character },
1046             character_describe( chr $codepoint ) );
1047             } ## end if ( $problem_code eq 'invalid char' )
1048              
1049 4110 100       8203 if ( $problem_code eq 'unregistered char' ) {
1050              
1051 4101         5795 state $op_alternative = Marpa::R2::Thin::op('alternative');
1052 4101         5510 state $op_invalid_char = Marpa::R2::Thin::op('invalid_char');
1053 4101         5382 state $op_earleme_complete =
1054             Marpa::R2::Thin::op('earleme_complete');
1055              
1056             # Recover by registering character, if we can
1057 4101         9166 my $codepoint = $thin_slr->codepoint();
1058             my $character =
1059 4101         5666 substr ${$slr->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING]},
  4101         12781  
1060             $thin_slr->pos(), 1;
1061 4101         7910 my $character_class_table =
1062             $slg->[Marpa::R2::Internal::Scanless::G::CHARACTER_CLASS_TABLES]
1063             ->[0];
1064 4101         5503 my @ops;
1065 4101         5439 for my $entry ( @{$character_class_table} ) {
  4101         7544  
1066              
1067 175713         223414 my ( $symbol_id, $re ) = @{$entry};
  175713         259476  
1068 175713 100       485022 if ( $character =~ $re ) {
1069              
1070 19735 100       36116 if ( $trace_terminals >= 2 ) {
1071 12         21 my $thick_lex_grammar =
1072             $slg->[
1073             Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
1074             ->[0];
1075 12         16 my $trace_file_handle = $slr->[
1076             Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
1077 12         37 my $char_desc = sprintf 'U+%04x', $codepoint;
1078 12 100       39 if ( $character =~ m/[[:graph:]]+/ ) {
1079 10         22 $char_desc .= qq{ '$character'};
1080             }
1081 12 50       17 say {$trace_file_handle}
  12         43  
1082             qq{Registering character $char_desc as symbol $symbol_id: },
1083             $thick_lex_grammar->symbol_in_display_form(
1084             $symbol_id)
1085             or
1086             Marpa::R2::exception("Could not say(): $ERRNO");
1087             } ## end if ( $trace_terminals >= 2 )
1088 19735         36002 push @ops, $op_alternative, $symbol_id, 1, 1;
1089             } ## end if ( $character =~ $re )
1090             } ## end for my $entry ( @{$character_class_table} )
1091              
1092 4101 100       9087 if ( not @ops ) {
1093 1         4 $thin_slr->char_register( $codepoint, $op_invalid_char );
1094 1         4 next OUTER_READ;
1095             }
1096 4100         15098 $thin_slr->char_register( $codepoint, @ops,
1097             $op_earleme_complete );
1098 4100         10110 next OUTER_READ;
1099             } ## end if ( $problem_code eq 'unregistered char' )
1100              
1101 9         54 return $slr->read_problem($problem_code);
1102              
1103             } ## end OUTER_READ: while (1)
1104              
1105 1884         8224 return $thin_slr->pos();
1106             } ## end sub Marpa::R2::Scanless::R::resume
1107              
1108             sub Marpa::R2::Scanless::R::event {
1109 333     333   1752 my ( $self, $event_ix ) = @_;
1110 333         559 return $self->[Marpa::R2::Internal::Scanless::R::EVENTS]->[$event_ix];
1111             }
1112              
1113             sub Marpa::R2::Scanless::R::events {
1114 962     962   7560 my ($self) = @_;
1115 962         2318 return $self->[Marpa::R2::Internal::Scanless::R::EVENTS];
1116             }
1117              
1118             ## From here, recovery is a matter for the caller,
1119             ## if it is possible at all
1120             sub Marpa::R2::Scanless::R::read_problem {
1121 9     9   40 my ( $slr, $problem_code ) = @_;
1122              
1123 9 50       62 die 'No problem_code in slr->read_problem()' if not $problem_code;
1124              
1125 9         28 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1126 9         22 my $grammar = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1127              
1128 9         26 my $thick_lex_grammar =
1129             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]->[0];
1130 9         40 my $lex_tracer = $thick_lex_grammar->tracer();
1131              
1132 9         25 my $trace_file_handle =
1133             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
1134              
1135 9         28 my $thick_g1_recce =
1136             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1137 9         34 my $thin_g1_recce = $thick_g1_recce->thin();
1138 9         84 my $thick_g1_grammar = $thick_g1_recce->grammar();
1139 9         34 my $g1_tracer = $thick_g1_grammar->tracer();
1140              
1141 9         37 my $pos = $thin_slr->pos();
1142 9         21 my $problem_pos = $pos;
1143 9         26 my $p_string = $slr->[Marpa::R2::Internal::Scanless::R::P_INPUT_STRING];
1144 9         18 my $length_of_string = length ${$p_string};
  9         30  
1145              
1146 9         21 my $problem;
1147 9         17 my $stream_status = 0;
1148 9         19 my $g1_status = 0;
1149             CODE_TO_PROBLEM: {
1150 9 100       18 if ( $problem_code eq 'R1 exhausted before end' ) {
  9         33  
1151 2         9 my ($lexeme_start) = $thin_slr->lexeme_span();
1152 2         8 my ( $line, $column ) = $slr->line_column($lexeme_start);
1153 2         9 $problem =
1154             "Parse exhausted, but lexemes remain, at line $line, column $column\n";
1155 2         5 last CODE_TO_PROBLEM;
1156             }
1157 7 50       29 if ( $problem_code eq 'SLIF loop' ) {
1158 0         0 my ($lexeme_start) = $thin_slr->lexeme_span();
1159 0         0 my ( $line, $column ) = $slr->line_column($lexeme_start);
1160 0         0 $problem = "SLIF loops at line $line, column $column";
1161 0         0 last CODE_TO_PROBLEM;
1162             }
1163 7 50       32 if ( $problem_code eq 'no lexeme' ) {
1164 7         31 $problem_pos = $thin_slr->problem_pos();
1165 7         36 my ( $line, $column ) = $slr->line_column($problem_pos);
1166 7         15 my $lexer_name;
1167 7         20 my @details = ();
1168 7         19 my %rejections = ();
1169 7         32 my @events = $thin_slr->events();
1170 7 50       31 if ( scalar @events > 100 ) {
1171 0         0 my $omitted = scalar @events - 100;
1172 0         0 push @details,
1173             " [there were $omitted events -- only the first 100 were examined]";
1174 0         0 $#events = 99;
1175             } ## end if ( scalar @events > 100 )
1176 7         27 EVENT: for my $event (@events) {
1177             my ( $event_type, $trace_event_type, $lexeme_start_pos,
1178             $lexeme_end_pos, $g1_lexeme )
1179 2         4 = @{$event};
  2         9  
1180             next EVENT
1181 2 50 33     44 if $event_type ne q{'trace}
1182             or $trace_event_type ne 'rejected lexeme';
1183 2         7 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1184 2         16 my $raw_token_value =
1185             $thin_slr->substring( $lexeme_start_pos,
1186             $lexeme_end_pos - $lexeme_start_pos );
1187 2         6 my $trace_file_handle =
1188             $slr
1189             ->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
1190 2         6 my $thick_g1_recce =
1191             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1192 2         8 my $thick_g1_grammar = $thick_g1_recce->grammar();
1193 2         9 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1194              
1195             # Different internal symbols may have the same external "display form",
1196             # which in naive reporting logic would result in many identical messages,
1197             # confusing the user. This logic makes sure that identical rejection
1198             # reports are not repeated, even when they have different causes
1199             # internally.
1200              
1201             $rejections{
1202 2         14 $thick_g1_grammar->symbol_in_display_form(
1203             $g1_lexeme)
1204             . qq{; value="$raw_token_value"; length = }
1205             . ( $lexeme_end_pos - $lexeme_start_pos ) } = 1;
1206             } ## end EVENT: for my $event (@events)
1207 7         20 my @problem = ();
1208 7         29 my @rejections = keys %rejections;
1209 7 100       28 if ( scalar @rejections ) {
1210 2         4 my $rejection_count = scalar @rejections;
1211 2         11 push @problem,
1212             "No lexemes accepted at line $line, column $column";
1213 2         9 REJECTION: for my $i ( 0 .. 5 ) {
1214 4         11 my $rejection = $rejections[$i];
1215 4 100       15 last REJECTION if not defined $rejection;
1216 2         9 push @problem, qq{ Rejected lexeme #$i: $rejection};
1217             }
1218 2 50       10 if ( $rejection_count > 5 ) {
1219 0         0 push @problem,
1220             " [there were $rejection_count rejection messages -- only the first 5 are shown]";
1221             }
1222 2         7 push @problem, @details;
1223             } ## end if ( scalar @rejections )
1224             else {
1225 5         27 push @problem,
1226             "No lexeme found at line $line, column $column";
1227             }
1228 7         28 $problem = join "\n", @problem;
1229 7         27 last CODE_TO_PROBLEM;
1230             } ## end if ( $problem_code eq 'no lexeme' )
1231 0         0 $problem = 'Unrecognized problem code: ' . $problem_code;
1232             } ## end CODE_TO_PROBLEM:
1233              
1234 9         22 my $desc;
1235             DESC: {
1236 9 50       20 if ( defined $problem ) {
  9         59  
1237 9         33 $desc .= "$problem";
1238             }
1239 9 50       36 if ( $stream_status == -1 ) {
1240 0         0 $desc = 'Lexer: Character rejected';
1241 0         0 last DESC;
1242             }
1243 9 50       31 if ( $stream_status == -2 ) {
1244 0         0 $desc = 'Lexer: Unregistered character';
1245 0         0 last DESC;
1246             }
1247              
1248             # -5 indicates success, in which case we should never have called this subroutine.
1249 9 50 33     85 if ( $stream_status == -3 || $stream_status == -5 ) {
1250 0         0 $desc = 'Unexpected return value from lexer: Parse exhausted';
1251 0         0 last DESC;
1252             }
1253 9 50       33 if ($g1_status) {
1254 0         0 my $true_event_count = $thin_slr->g1()->event_count();
1255             EVENT:
1256 0         0 for (
1257             my $event_ix = 0;
1258             $event_ix < $true_event_count;
1259             $event_ix++
1260             )
1261             {
1262 0         0 my ( $event_type, $value ) =
1263             $thin_slr->g1()->event($event_ix);
1264 0 0       0 if ( $event_type eq 'MARPA_EVENT_EARLEY_ITEM_THRESHOLD' ) {
1265 0         0 $desc = join "\n", $desc,
1266             "G1 grammar: Earley item count ($value) exceeds warning threshold\n";
1267 0         0 next EVENT;
1268             }
1269 0 0       0 if ( $event_type eq 'MARPA_EVENT_SYMBOL_EXPECTED' ) {
1270 0         0 $desc = join "\n", $desc,
1271             "Unexpected G1 grammar event: $event_type "
1272             . $g1_tracer->symbol_name($value);
1273 0         0 next EVENT;
1274             } ## end if ( $event_type eq 'MARPA_EVENT_SYMBOL_EXPECTED' )
1275 0 0       0 if ( $event_type eq 'MARPA_EVENT_EXHAUSTED' ) {
1276 0         0 $desc = join "\n", $desc, 'Parse exhausted';
1277 0         0 next EVENT;
1278             }
1279 0         0 Marpa::R2::exception( $desc, "\n",
1280             qq{Unknown event: "$event_type"; event value = $value\n}
1281             );
1282             } ## end EVENT: for ( my $event_ix = 0; $event_ix < ...)
1283 0         0 last DESC;
1284             } ## end if ($g1_status)
1285 9 50       34 if ( $g1_status < 0 ) {
1286 0         0 $desc = 'G1 error: ' . $thin_slr->g1()->error();
1287 0         0 chomp $desc;
1288 0         0 last DESC;
1289             }
1290             } ## end DESC:
1291 9         20 my $read_string_error;
1292 9 50       35 if ( $problem_pos < $length_of_string) {
1293 9         19 my $char = substr ${$p_string}, $problem_pos, 1;
  9         30  
1294 9         39 my $char_desc = character_describe($char);
1295 9         84 my ( $line, $column ) = $thin_slr->line_column($problem_pos);
1296             my $prefix =
1297             $problem_pos >= 50
1298 0         0 ? ( substr ${$p_string}, $problem_pos - 50, 50 )
1299 9 50       35 : ( substr ${$p_string}, 0, $problem_pos );
  9         34  
1300              
1301             $read_string_error =
1302             "Error in SLIF parse: $desc\n"
1303             . '* String before error: '
1304             . Marpa::R2::escape_string( $prefix, -50 ) . "\n"
1305             . "* The error was at line $line, column $column, and at character $char_desc, ...\n"
1306             . '* here: '
1307 9         67 . Marpa::R2::escape_string( ( substr ${$p_string}, $problem_pos, 50 ),
  9         48  
1308             50 )
1309             . "\n";
1310             } ## end elsif ( $problem_pos < $length_of_string )
1311             else {
1312             $read_string_error =
1313             "Error in SLIF parse: $desc\n"
1314             . "* Error was at end of input\n"
1315             . '* String before error: '
1316 0         0 . Marpa::R2::escape_string( ${$p_string}, -50 ) . "\n";
  0         0  
1317             } ## end else [ if ($g1_status) ]
1318              
1319 9 50       47 if ( $slr->[Marpa::R2::Internal::Scanless::R::TRACE_LEXERS] ) {
1320 0         0 my $stream_pos = $thin_slr->pos();
1321 0         0 my $trace_file_handle =
1322             $slr->[Marpa::R2::Internal::Scanless::R::TRACE_FILE_HANDLE];
1323 0         0 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1324 0         0 my $thick_lex_grammar =
1325             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]->[0];
1326 0         0 my $lex_tracer = $thick_lex_grammar->tracer();
1327 0         0 my ( $line, $column ) = $slr->line_column($stream_pos);
1328 0         0 $read_string_error .=
1329             qq{\n=== Progress report for lexer at line $line, column $column\n} .
1330             $lex_tracer->lexer_progress_report($slr);
1331             }
1332              
1333 9         28 $slr->[Marpa::R2::Internal::Scanless::R::READ_STRING_ERROR] =
1334             $read_string_error;
1335 9         57 Marpa::R2::exception($read_string_error);
1336              
1337             # Never reached
1338             # Fall through to return undef
1339 0         0 return;
1340              
1341             } ## end sub Marpa::R2::Scanless::R::read_problem
1342              
1343             sub character_describe {
1344 9     9   28 my ($char) = @_;
1345 9         59 my $text = sprintf '0x%04x', ord $char;
1346 9 50       77 $text .= q{ }
1347             . (
1348             $char =~ m/[[:graph:]]/xms
1349             ? qq{'$char'}
1350             : '(non-graphic character)'
1351             );
1352 9         29 return $text;
1353             } ## end sub character_describe
1354              
1355             my @escape_by_ord = ();
1356             $escape_by_ord[ ord q{\\} ] = q{\\\\};
1357             $escape_by_ord[ ord eval qq{"$_"} ] = $_
1358             for "\\t", "\\r", "\\f", "\\b", "\\a", "\\e";
1359             $escape_by_ord[0xa] = '\\n';
1360             $escape_by_ord[$_] //= chr $_ for 32 .. 126;
1361             $escape_by_ord[$_] //= sprintf( "\\x%02x", $_ ) for 0 .. 255;
1362              
1363             # This and the sister routine for "forward strings"
1364             # should replace the other string "escaping" subroutine
1365             # in the NAIF
1366             sub Marpa::R2::Internal::Scanless::reversed_input_escape {
1367 0     0   0 my ( $p_input, $base_pos, $length ) = @_;
1368 0         0 my @escaped_chars = ();
1369 0         0 my $pos = $base_pos - 1 ;
1370              
1371 0         0 my $trailing_spaces = 0;
1372 0         0 CHAR: while ( $pos > 0 ) {
1373 0 0       0 last CHAR if substr ${$p_input}, $pos, 1 ne q{ };
  0         0  
1374 0         0 $trailing_spaces++;
1375 0         0 $pos--;
1376             }
1377 0         0 my $length_so_far = $trailing_spaces * 2;
1378              
1379 0         0 CHAR: while ( $pos >= 0 ) {
1380 0         0 my $char = substr ${$p_input}, $pos, 1;
  0         0  
1381 0         0 my $ord = ord $char;
1382 0   0     0 my $escaped_char = $escape_by_ord[$ord]
1383             // sprintf( "\\x{%04x}", $ord );
1384 0         0 my $char_length = length $escaped_char;
1385 0         0 $length_so_far += $char_length;
1386 0 0       0 last CHAR if $length_so_far > $length;
1387 0         0 push @escaped_chars, $escaped_char;
1388 0         0 $pos--;
1389             } ## end CHAR: while ( $pos > 0 and $pos < $end_of_input )
1390 0         0 @escaped_chars = reverse @escaped_chars;
1391 0         0 push @escaped_chars, '\\s' for 1 .. $trailing_spaces;
1392 0         0 return join q{}, @escaped_chars;
1393             } ## end sub Marpa::R2::Internal::Scanless::input_escape
1394              
1395             sub Marpa::R2::Internal::Scanless::input_escape {
1396 11     11   28 my ( $p_input, $base_pos, $length ) = @_;
1397 11         24 my @escaped_chars = ();
1398 11         17 my $pos = $base_pos;
1399              
1400 11         22 my $length_so_far = 0;
1401              
1402 11         17 my $end_of_input = length ${$p_input};
  11         24  
1403 11         32 CHAR: while ( $pos < $end_of_input ) {
1404 121         143 my $char = substr ${$p_input}, $pos, 1;
  121         184  
1405 121         166 my $ord = ord $char;
1406 121   33     248 my $escaped_char = $escape_by_ord[$ord]
1407             // sprintf( "\\x{%04x}", $ord );
1408 121         164 my $char_length = length $escaped_char;
1409 121         142 $length_so_far += $char_length;
1410 121 100       208 last CHAR if $length_so_far > $length;
1411 113         204 push @escaped_chars, $escaped_char;
1412 113         195 $pos++;
1413             } ## end CHAR: while ( $pos < $end_of_input )
1414              
1415 11         24 my $trailing_spaces = 0;
1416             TRAILING_SPACE:
1417 11         50 for (
1418             my $first_non_space_ix = $#escaped_chars;
1419             $first_non_space_ix >= 0;
1420             $first_non_space_ix--
1421             )
1422             {
1423 11 50       40 last TRAILING_SPACE if $escaped_chars[$first_non_space_ix] ne q{ };
1424 0         0 pop @escaped_chars;
1425 0         0 $trailing_spaces++;
1426             } ## end TRAILING_SPACE: for ( my $first_non_space_ix = $#escaped_chars; ...)
1427 11 50       27 if ($trailing_spaces) {
1428 0         0 $length_so_far -= $trailing_spaces;
1429 0         0 TRAILING_SPACE: while ( $trailing_spaces-- > 0 ) {
1430 0         0 $length_so_far += 2;
1431 0 0       0 last TRAILING_SPACE if $length_so_far > $length;
1432 0         0 push @escaped_chars, '\\s';
1433             }
1434             } ## end if ($trailing_spaces)
1435 11         69 return join q{}, @escaped_chars;
1436             } ## end sub Marpa::R2::Internal::Scanless::input_escape
1437              
1438             sub Marpa::R2::Scanless::R::ambiguity_metric {
1439 219     219   1605 my ($slr) = @_;
1440 219         692 my $thick_g1_recce =
1441             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1442 219         1133 my $ordering = $thick_g1_recce->ordering_get();
1443 219 50       2699 my $metric = $ordering ? $ordering->ambiguity_metric() : 0;
1444 219         739 my $bocage = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::B_C];
1445 219         608 return $metric;
1446             } ## end sub Marpa::R2::Scanless::R::ambiguity_metric
1447              
1448             sub Marpa::R2::Scanless::R::ambiguous {
1449 208     208   703 my ($slr) = @_;
1450 208         609 local $Marpa::R2::Context::slr = $slr;
1451 208         904 my $ambiguity_metric = $slr->ambiguity_metric();
1452 208 50       765 return q{No parse} if $ambiguity_metric <= 0;
1453 208 100       1514 return q{} if $ambiguity_metric == 1;
1454 4         51 my $asf = Marpa::R2::ASF->new( { slr => $slr } );
1455 4 50       21 die 'Could not create ASF' if not defined $asf;
1456 4         19 my $ambiguities = Marpa::R2::Internal::ASF::ambiguities($asf);
1457 4         13 my @ambiguities = grep {defined} @{$ambiguities}[ 0 .. 1 ];
  8         22  
  4         17  
1458 4         33 return Marpa::R2::Internal::ASF::ambiguities_show( $asf, \@ambiguities );
1459             } ## end sub Marpa::R2::Scanless::R::ambiguous
1460              
1461             # This is a Marpa Scanless::G method, but is included in this
1462             # file because internally it is all about the recognizer.
1463             sub Marpa::R2::Scanless::G::parse {
1464 2     2   38 my ( $slg, $input_ref, $arg1, @more_args ) = @_;
1465 2 50 33     29 if ( not defined $input_ref or ref $input_ref ne 'SCALAR' ) {
1466 0         0 Marpa::R2::exception(
1467             q{$slr->parse(): first argument must be a ref to string});
1468             }
1469 2         12 my @recce_args = ( { grammar => $slg } );
1470 2         8 my @semantics_package_arg = ();
1471             DO_ARG1: {
1472 2 50       6 last if not defined $arg1;
  2         8  
1473 2         5 my $reftype = ref $arg1;
1474 2 50       10 if ( $reftype eq 'HASH' ) {
1475              
1476             # if second arg is ref to hash, it is the first set
1477             # of named args for
1478             # the recognizer
1479 0         0 push @recce_args, $arg1;
1480 0         0 last DO_ARG1;
1481             } ## end if ( $reftype eq 'HASH' )
1482 2 50       9 if ( $reftype eq q{} ) {
1483              
1484             # if second arg is a string, it is the semantic package
1485 2         10 push @semantics_package_arg, { semantics_package => $arg1 };
1486             }
1487 2 50 33     10 if ( ref $arg1 and ref $input_ref ne 'HASH' ) {
1488 0         0 Marpa::R2::exception(
1489             q{$slr->parse(): second argument must be a package name or a ref to HASH}
1490             );
1491             }
1492             } ## end DO_ARG1:
1493 2 50       12 if ( grep { ref $_ ne 'HASH' } @more_args ) {
  0         0  
1494 0         0 Marpa::R2::exception(
1495             q{$slr->parse(): third and later arguments must be ref to HASH});
1496             }
1497 2         18 my $slr = Marpa::R2::Scanless::R->new( @recce_args, @more_args,
1498             @semantics_package_arg );
1499 2         6 my $input_length = ${$input_ref};
  2         8  
1500 2         12 my $length_read = $slr->read($input_ref);
1501 2 50       11 if ( $length_read != length $input_length ) {
1502 0         0 die 'read in $slr->parse() ended prematurely', "\n",
1503             " The input length is $input_length\n",
1504             " The length read is $length_read\n",
1505             " The cause may be an event\n",
1506             " The $slr->parse() method does not allow parses to trigger events";
1507             } ## end if ( $length_read != length $input_length )
1508 2 50       13 if ( my $ambiguous_status = $slr->ambiguous() ) {
1509 0         0 Marpa::R2::exception( "Parse of the input is ambiguous\n",
1510             $ambiguous_status );
1511             }
1512              
1513 2         8 my $value_ref = $slr->value();
1514 2 50       10 Marpa::R2::exception(
1515             '$slr->parse() read the input, but there was no parse', "\n" )
1516             if not $value_ref;
1517              
1518 2         46 return $value_ref;
1519             } ## end sub Marpa::R2::Scanless::G::parse
1520              
1521             sub Marpa::R2::Scanless::R::rule_closure {
1522              
1523 15     15   44 my ( $slr, $rule_id ) = @_;
1524              
1525 15         24 my $recce = $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1526              
1527 15 100       58 if ( not $recce->[Marpa::R2::Internal::Recognizer::REGISTRATIONS] ) {
1528              
1529 1         3 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
1530 1         3 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1531 1         3 my $recce_c = $recce->[Marpa::R2::Internal::Recognizer::C];
1532 1         4 my $per_parse_arg = {};
1533 1   50     6 my $trace_actions = $recce->[Marpa::R2::Internal::Recognizer::TRACE_ACTIONS] // 0;
1534 1         5 my $trace_file_handle = $recce->[Marpa::R2::Internal::Recognizer::TRACE_FILE_HANDLE];
1535 1         3 my $rules = $grammar->[Marpa::R2::Internal::Grammar::RULES];
1536 1         2 my $symbols = $grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
1537 1         2 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
1538              
1539 1         6 Marpa::R2::Internal::Value::registration_init( $recce, $per_parse_arg );
1540              
1541             } ## end if ( not $recce->[Marpa::R2::Internal::Recognizer::REGISTRATIONS...])
1542              
1543 15         27 my $rule_closure = $recce->[Marpa::R2::Internal::Recognizer::CLOSURE_BY_RULE_ID]->[$rule_id];
1544 15 50       33 if (defined $rule_closure){
1545 15         27 my $ref_rule_closure = ref $rule_closure;
1546 15 50       28 if ( $ref_rule_closure eq 'CODE' ){
    0          
1547 15         32 return $rule_closure;
1548             }
1549             elsif ( $ref_rule_closure eq 'SCALAR' ){
1550 0         0 return $rule_closure;
1551             }
1552             }
1553             else{
1554             return
1555 0         0 }
1556              
1557             } ## end sub Marpa::R2::Scanless::R::rule_closure
1558              
1559             sub Marpa::R2::Scanless::R::value {
1560 1556     1556   302240 my ( $slr, $per_parse_arg ) = @_;
1561 1556         3066 my $thick_g1_recce =
1562             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1563 1556         5122 my $thick_g1_value = $thick_g1_recce->value( $slr, $per_parse_arg );
1564 1553         5093 return $thick_g1_value;
1565             } ## end sub Marpa::R2::Scanless::R::value
1566              
1567             sub Marpa::R2::Scanless::R::series_restart {
1568 56     56   19692 my ( $slr , @args ) = @_;
1569 56         138 my $thick_g1_recce =
1570             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1571              
1572             # Reset SLIF (not NAIF) recognizer args to default
1573 56         122 $slr->[Marpa::R2::Internal::Scanless::R::EXHAUSTION_ACTION] = 'fatal';
1574 56         113 $slr->[Marpa::R2::Internal::Scanless::R::REJECTION_ACTION] = 'fatal';
1575              
1576 56         230 $thick_g1_recce->reset_evaluation();
1577 56         302 my ($g1_recce_args) = Marpa::R2::Internal::Scanless::R::set($slr, "series_restart", @args );
1578 56         347 $thick_g1_recce->set( $g1_recce_args );
1579 56         202 return 1;
1580             }
1581              
1582             # Given a list of G1 locations, return the minimum span in the input string
1583             # that includes them all
1584             # Caller must ensure that there is an input, which is not the case
1585             # when the parse is initialized.
1586             sub g1_locations_to_input_range {
1587 108     108   226 my ( $slr, @g1_locations ) = @_;
1588 108         182 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1589 108         223 my $first_pos = $thin_slr->input_length();
1590 108         148 my $last_pos = 0;
1591 108         176 for my $g1_location (@g1_locations) {
1592 269         587 my ( $input_start, $input_length ) = $thin_slr->span($g1_location);
1593 269 100       506 my $input_end = $input_length ? $input_start + $input_length - 1 : $input_start;
1594 269 100       481 $first_pos = $input_start if $input_start < $first_pos;
1595 269 100       508 $last_pos = $input_end if $input_end > $last_pos;
1596             } ## end for my $g1_location (@other_g1_locations)
1597 108         266 return ($first_pos, $last_pos);
1598             }
1599              
1600             sub input_range_describe {
1601 141     141   240 my ( $slr, $first_pos, $last_pos ) = @_;
1602 141         286 my ( $first_line, $first_column ) = $slr->line_column($first_pos);
1603 141         246 my ( $last_line, $last_column ) = $slr->line_column($last_pos);
1604 141 100       298 if ( $first_line == $last_line ) {
1605 129 100       412 return join q{}, 'L', $first_line, 'c', $first_column
1606             if $first_column == $last_column;
1607 71         217 return join q{}, 'L', $first_line, 'c', $first_column, '-',
1608             $last_column;
1609             } ## end if ( $first_line == $last_line )
1610 12         36 return join q{}, 'L', $first_line, 'c', $first_column, '-L', $last_line,
1611             'c', $last_column;
1612             } ## end sub input_range_describe
1613              
1614             sub Marpa::R2::Scanless::R::show_progress {
1615 13     13   1405 my ( $slr, $start_ordinal, $end_ordinal ) = @_;
1616 13         27 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1617 13         24 my $recce = $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1618 13         24 my $grammar = $recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
1619 13         24 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1620              
1621 13         37 my $last_ordinal = $recce->latest_earley_set();
1622              
1623 13 100       43 if ( not defined $start_ordinal ) {
1624 2         5 $start_ordinal = $last_ordinal;
1625             }
1626 13 50       37 if ( $start_ordinal < 0 ) {
1627 0         0 $start_ordinal += $last_ordinal + 1;
1628             }
1629             else {
1630 13 50 33     65 if ( $start_ordinal < 0 or $start_ordinal > $last_ordinal ) {
1631             return
1632 0         0 "Marpa::PP::Recognizer::show_progress start index is $start_ordinal, "
1633             . "must be in range 0-$last_ordinal";
1634             }
1635             } ## end else [ if ( $start_ordinal < 0 ) ]
1636              
1637 13 100       36 if ( not defined $end_ordinal ) {
1638 12         17 $end_ordinal = $start_ordinal;
1639             }
1640             else {
1641 1         5 my $end_ordinal_argument = $end_ordinal;
1642 1 50       6 if ( $end_ordinal < 0 ) {
1643 1         5 $end_ordinal += $last_ordinal + 1;
1644             }
1645 1 50       4 if ( $end_ordinal < 0 ) {
1646             return
1647 0         0 "Marpa::PP::Recognizer::show_progress end index is $end_ordinal_argument, "
1648             . sprintf ' must be in range %d-%d', -( $last_ordinal + 1 ),
1649             $last_ordinal;
1650             } ## end if ( $end_ordinal < 0 )
1651             } ## end else [ if ( not defined $end_ordinal ) ]
1652              
1653 13         33 my $text = q{};
1654 13         36 for my $current_ordinal ( $start_ordinal .. $end_ordinal ) {
1655 18         58 my $current_earleme = $recce->earleme($current_ordinal);
1656 18         36 my %by_rule_by_position = ();
1657 18         27 for my $progress_item ( @{ $recce->progress($current_ordinal) } ) {
  18         117  
1658 170         208 my ( $rule_id, $position, $origin ) = @{$progress_item};
  170         270  
1659 170 100       297 if ( $position < 0 ) {
1660 100         173 $position = $grammar_c->rule_length($rule_id);
1661             }
1662 170         432 $by_rule_by_position{$rule_id}->{$position}->{$origin}++;
1663             } ## end for my $progress_item ( @{ $recce->progress($current_ordinal...)})
1664              
1665 18         126 for my $rule_id ( sort { $a <=> $b } keys %by_rule_by_position ) {
  174         268  
1666 98         176 my $by_position = $by_rule_by_position{$rule_id};
1667 98         146 for my $position ( sort { $a <=> $b } keys %{$by_position} ) {
  19         61  
  98         316  
1668 117         170 my $raw_origins = $by_position->{$position};
1669 117         159 my @origins = sort { $a <=> $b } keys %{$raw_origins};
  135         233  
  117         319  
1670 117         203 my $origins_count = scalar @origins;
1671 117         195 my $origin_desc;
1672 117 100       219 if ( $origins_count <= 3 ) {
1673 114         210 $origin_desc = join q{,}, @origins;
1674             }
1675             else {
1676 3         10 $origin_desc = $origins[0] . q{...} . $origins[-1];
1677             }
1678              
1679 117         293 my $rhs_length = $grammar_c->rule_length($rule_id);
1680 117         175 my @item_text;
1681              
1682 117 100       249 if ( $position >= $rhs_length ) {
    100          
1683 47         97 push @item_text, "F$rule_id";
1684             }
1685             elsif ($position) {
1686 28         61 push @item_text, "R$rule_id:$position";
1687             }
1688             else {
1689 42         91 push @item_text, "P$rule_id";
1690             }
1691 117 100       307 push @item_text, "x$origins_count" if $origins_count > 1;
1692 117         255 push @item_text, q{@} . $origin_desc . q{-} . $current_earleme;
1693              
1694 117 100       204 if ( $current_earleme > 0 ) {
1695 108         215 my $input_range = input_range_describe(
1696             $slr,
1697             g1_locations_to_input_range(
1698             $slr, $current_earleme, @origins
1699             )
1700             );
1701 108         212 push @item_text, $input_range;
1702             }
1703             else {
1704 9         15 push @item_text, 'L0c0';
1705             }
1706              
1707 117         314 push @item_text, $slg->show_dotted_rule( $rule_id, $position );
1708 117         584 $text .= ( join q{ }, @item_text ) . "\n";
1709             } ## end for my $position ( sort { $a <=> $b } keys %{...})
1710             } ## end for my $rule_id ( sort { $a <=> $b } keys ...)
1711              
1712             } ## end for my $current_ordinal ( $start_ordinal .. $end_ordinal)
1713 13         48 return $text;
1714             }
1715              
1716             sub Marpa::R2::Scanless::R::progress {
1717 30     30   17265 my ( $self, @args ) = @_;
1718 30         122 return $self->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1719             ->progress(@args);
1720             }
1721              
1722             sub Marpa::R2::Scanless::R::terminals_expected {
1723 69     69   447 my ($self) = @_;
1724 69         168 return $self->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1725             ->terminals_expected();
1726             }
1727              
1728             sub Marpa::R2::Scanless::R::exhausted {
1729 18     18   257 my ($self) = @_;
1730 18         58 return $self->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1731             ->exhausted();
1732             }
1733              
1734             # Latest and current G1 location are the same
1735             sub Marpa::R2::Scanless::R::latest_g1_location {
1736 1     1   563 my ($slg) = @_;
1737 1         5 return $slg->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1738             ->latest_earley_set();
1739             }
1740              
1741             # Latest and current G1 location are the same
1742             sub Marpa::R2::Scanless::R::current_g1_location {
1743 137     137   1515 my ($slg) = @_;
1744 137         431 return $slg->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1745             ->latest_earley_set();
1746             }
1747              
1748             sub Marpa::R2::Scanless::R::lexeme_alternative {
1749 194     194   2193 my ( $slr, $symbol_name, @value ) = @_;
1750 194         327 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1751              
1752 194 50       423 Marpa::R2::exception(
1753             "slr->alternative(): symbol name is undefined\n",
1754             " The symbol name cannot be undefined\n"
1755             ) if not defined $symbol_name;
1756              
1757 194         289 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1758 194         295 my $g1_grammar = $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1759 194         469 my $g1_tracer = $g1_grammar->tracer();
1760 194         529 my $symbol_id = $g1_tracer->symbol_by_name($symbol_name);
1761 194 50       409 if ( not defined $symbol_id ) {
1762 0         0 Marpa::R2::exception(
1763             qq{slr->alternative(): symbol "$symbol_name" does not exist});
1764             }
1765              
1766 194         693 my $result = $thin_slr->g1_alternative( $symbol_id, @value );
1767 194 50       652 return 1 if $result == $Marpa::R2::Error::NONE;
1768              
1769             # The last two are perhaps unnecessary or arguable,
1770             # but they preserve compatibility with Marpa::XS
1771             return
1772 0 0 0     0 if $result == $Marpa::R2::Error::UNEXPECTED_TOKEN_ID
      0        
1773             || $result == $Marpa::R2::Error::NO_TOKEN_EXPECTED_HERE
1774             || $result == $Marpa::R2::Error::INACCESSIBLE_TOKEN;
1775              
1776 0         0 Marpa::R2::exception( qq{Problem reading symbol "$symbol_name": },
1777             ( scalar $g1_grammar->error() ) );
1778             } ## end sub Marpa::R2::Scanless::R::lexeme_alternative
1779              
1780             # Returns 0 on unthrown failure, current location on success
1781             sub Marpa::R2::Scanless::R::lexeme_complete {
1782 194     194   378 my ( $slr, $start, $length ) = @_;
1783 194 50 66     841 Marpa::R2::exception( q{Bad call to $recce->lexeme_complete(): },
1784             qq{start "$start" is not numeric})
1785             if defined $start
1786             and not Scalar::Util::looks_like_number( $start );
1787 194 50 33     673 Marpa::R2::exception( q{Bad call to $recce->lexeme_complete(): },
1788             qq{length "$length" is not numeric})
1789             if defined $length
1790             and not Scalar::Util::looks_like_number( $length );
1791 194         309 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1792 194         387 $slr->[Marpa::R2::Internal::Scanless::R::EVENTS] = [];
1793 194         419 my $thin_pos = $thin_slr->pos();
1794 194   100     410 $start //= $thin_pos;
1795 194 50       410 if (not defined $length) {
1796 0         0 my ($pause_start, $pause_length) = $thin_slr->pause_span();
1797 0 0       0 $length = ($pause_start == $thin_pos) ? $pause_length : -1;
1798             }
1799 194         1067 my $return_value = $thin_slr->g1_lexeme_complete($start, $length);
1800 194         538 Marpa::R2::Internal::Scanless::convert_libmarpa_events($slr);
1801 194 50       411 die q{} . $thin_slr->g1()->error() if $return_value == 0;
1802 194         456 return $return_value;
1803             } ## end sub Marpa::R2::Scanless::R::lexeme_complete
1804              
1805             # Returns 0 on unthrown failure, current location on success,
1806             # undef if lexeme not accepted.
1807             sub Marpa::R2::Scanless::R::lexeme_read {
1808 163     163   7258 my ( $slr, $symbol_name, $start, $length, @value ) = @_;
1809 163 50       385 return if not $slr->lexeme_alternative( $symbol_name, @value );
1810 163         353 return $slr->lexeme_complete( $start, $length );
1811             }
1812              
1813             sub Marpa::R2::Scanless::R::pause_span {
1814 242     242   1859 my ($slr) = @_;
1815 242         362 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1816 242         689 return $thin_slr->pause_span();
1817             }
1818              
1819             sub Marpa::R2::Scanless::R::pause_lexeme {
1820 67     67   238 my ($slr) = @_;
1821 67         101 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1822 67         93 my $grammar = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1823 67         88 my $thick_g1_grammar =
1824             $grammar->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1825 67         157 my $g1_tracer = $thick_g1_grammar->tracer();
1826 67         135 my $symbol = $thin_slr->pause_lexeme();
1827 67 100       137 return if not defined $symbol;
1828 66         157 return $g1_tracer->symbol_name($symbol);
1829             } ## end sub Marpa::R2::Scanless::R::pause_lexeme
1830              
1831             sub Marpa::R2::Scanless::R::line_column {
1832 429     429   1022 my ( $slr, $pos ) = @_;
1833 429         625 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1834 429   33     767 $pos //= $thin_slr->pos();
1835 429         1094 return $thin_slr->line_column($pos);
1836             } ## end sub Marpa::R2::Scanless::R::line_column
1837              
1838             sub Marpa::R2::Scanless::R::pos {
1839 9     9   584 my ( $slr ) = @_;
1840 9         24 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1841 9         28 return $thin_slr->pos();
1842             }
1843              
1844             sub Marpa::R2::Scanless::R::input_length {
1845 1     1   531 my ( $slr ) = @_;
1846 1         3 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1847 1         10 return $thin_slr->input_length();
1848             }
1849              
1850             # no return value documented
1851             sub Marpa::R2::Scanless::R::activate {
1852 536     536   1660 my ( $slr, $event_name, $activate ) = @_;
1853 536         749 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1854 536         685 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1855 536   100     948 $activate //= 1;
1856 536         705 my $thick_g1_recce =
1857             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1858 536         1050 my $thin_g1_recce = $thick_g1_recce->thin();
1859             my $event_symbol_ids_by_type =
1860             $slg
1861             ->[Marpa::R2::Internal::Scanless::G::SYMBOL_IDS_BY_EVENT_NAME_AND_TYPE]
1862 536         825 ->{$event_name};
1863             $thin_g1_recce->completion_symbol_activate( $_, $activate )
1864 536         726 for @{ $event_symbol_ids_by_type->{completion} };
  536         1137  
1865             $thin_g1_recce->nulled_symbol_activate( $_, $activate )
1866 536         674 for @{ $event_symbol_ids_by_type->{nulled} };
  536         944  
1867             $thin_g1_recce->prediction_symbol_activate( $_, $activate )
1868 536         659 for @{ $event_symbol_ids_by_type->{prediction} };
  536         1016  
1869             $thin_slr->lexeme_event_activate( $_, $activate )
1870 536         682 for @{ $event_symbol_ids_by_type->{lexeme} };
  536         859  
1871 536         957 return 1;
1872             } ## end sub Marpa::R2::Scanless::R::activate
1873              
1874             # On success, returns the old priority value.
1875             # Failures are thrown.
1876             sub Marpa::R2::Scanless::R::lexeme_priority_set {
1877 12     12   57 my ($slr, $lexeme_name, $new_priority) = @_;
1878 12         18 my $thin_slr = $slr->[Marpa::R2::Internal::Scanless::R::C];
1879 12         20 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1880 12         17 my $thick_g1_grammar =
1881             $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1882 12         68 my $g1_tracer = $thick_g1_grammar->tracer();
1883 12         31 my $lexeme_id = $g1_tracer->symbol_by_name($lexeme_name);
1884 12 50       27 Marpa::R2::exception("Bad symbol in lexeme_priority_set(): $lexeme_name")
1885             if not defined $lexeme_id;
1886 12         35 return $thin_slr->lexeme_priority_set($lexeme_id, $new_priority);
1887             }
1888              
1889             # Internal methods, not to be documented
1890              
1891             sub Marpa::R2::Scanless::R::thick_g1_grammar {
1892 0     0   0 my ($slr) = @_;
1893 0         0 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1894 0         0 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1895             }
1896              
1897             sub Marpa::R2::Scanless::R::thick_g1_recce {
1898 0     0   0 my ($slr) = @_;
1899 0         0 return $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1900             }
1901              
1902             sub Marpa::R2::Scanless::R::default_g1_start_closure {
1903 0     0   0 my ($slr) = @_;
1904 0         0 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1905 0         0 my $default_action_name =
1906             $slg->[Marpa::R2::Internal::Scanless::G::DEFAULT_G1_START_ACTION];
1907 0         0 my $thick_g1_recce =
1908             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1909 0         0 my $resolution =
1910             Marpa::R2::Internal::Recognizer::resolve_action( $thick_g1_recce,
1911             $default_action_name );
1912 0 0       0 return if not $resolution;
1913 0         0 my ( undef, $closure ) = @{$resolution};
  0         0  
1914 0         0 return $closure;
1915             } ## end sub Marpa::R2::Scanless::R::default_g1_start_closure
1916              
1917             # not to be documented
1918             sub Marpa::R2::Scanless::R::latest_earley_set {
1919 1     1   968 my ($self) = @_;
1920 1         6 return $self->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1921             ->latest_earley_set();
1922             }
1923              
1924             sub Marpa::R2::Scanless::R::earley_set_size {
1925 0     0   0 my ($self, $set_id) = @_;
1926             # OK if set ID is undef, just pass it on.
1927 0         0 return $self->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE]
1928             ->earley_set_size($set_id);
1929             }
1930              
1931             sub Marpa::R2::Scanless::R::verbose_or_nodes {
1932 0     0   0 my ( $slr ) = @_;
1933 0         0 my $thick_g1_recce =
1934             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1935 0         0 return $thick_g1_recce->verbose_or_nodes();
1936             }
1937              
1938             sub Marpa::R2::Scanless::R::show_and_nodes {
1939 0     0   0 my ( $slr, $verbose ) = @_;
1940 0   0     0 $verbose //= 0;
1941 0         0 my $thick_g1_recce =
1942             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1943 0         0 return $thick_g1_recce->show_and_nodes($verbose);
1944             }
1945              
1946             sub Marpa::R2::Scanless::R::show_bocage {
1947 0     0   0 my ( $slr, $verbose ) = @_;
1948 0   0     0 $verbose //= 0;
1949 0         0 my $thick_g1_recce =
1950             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1951 0         0 return $thick_g1_recce->show_bocage($verbose);
1952             }
1953              
1954             sub Marpa::R2::Scanless::R::show_earley_sets {
1955 0     0   0 my ( $slr, $verbose ) = @_;
1956 0   0     0 $verbose //= 0;
1957 0         0 my $thick_g1_recce =
1958             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1959 0         0 return $thick_g1_recce->show_earley_sets($verbose);
1960             }
1961              
1962             sub Marpa::R2::Scanless::R::show_leo_items {
1963 10     10   30 my ( $slr, $ordinal ) = @_;
1964 10         21 my $thick_g1_recce =
1965             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
1966 10         16 my $grammar = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
1967 10         16 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1968 10         12 my $recce_c = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::C];
1969              
1970 10         30 my $last_ordinal = $thick_g1_recce->latest_earley_set();
1971 10 50 33     45 if ( $ordinal < 0 or $ordinal > $last_ordinal ) {
1972             return
1973 0         0 "Marpa::PP::Recognizer::show_leo_items start index is $ordinal, "
1974             . "must be in range 0-$last_ordinal";
1975             }
1976 10 50       48 die if not defined $recce_c->_marpa_r_earley_set_trace($ordinal);
1977 10         17 my @lines = ();
1978             POSTDOT_ITEM:
1979 10         37 for (
1980             my $postdot_symbol_id = $recce_c->_marpa_r_first_postdot_item_trace() ;
1981             defined $postdot_symbol_id ;
1982             $postdot_symbol_id = $recce_c->_marpa_r_next_postdot_item_trace()
1983             )
1984             {
1985              
1986             # If there is no base Earley item,
1987             # then this is not a Leo item, so we skip it
1988 38         69 my $leo_item_desc = $slr->show_leo_item();
1989 38 100       114 next POSTDOT_ITEM if not defined $leo_item_desc;
1990 6         21 push @lines, $leo_item_desc;
1991             } ## end POSTDOT_ITEM: for ( my $postdot_symbol_id = $recce_c...)
1992              
1993 10         35 return join "\n", @lines, '';
1994             }
1995              
1996             sub Marpa::R2::Scanless::R::show_leo_item {
1997 38     38   58 my ($slr) = @_;
1998 38         50 my $slg = $slr->[Marpa::R2::Internal::Scanless::R::GRAMMAR];
1999 38         48 my $thick_g1_recce =
2000             $slr->[Marpa::R2::Internal::Scanless::R::THICK_G1_RECCE];
2001 38         50 my $recce_c = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::C];
2002 38         48 my $grammar = $thick_g1_recce->[Marpa::R2::Internal::Recognizer::GRAMMAR];
2003 38         49 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
2004 38         49 my $tracer = $grammar->[Marpa::R2::Internal::Grammar::TRACER];
2005 38         69 my $base_ahm_id = $recce_c->_marpa_r_leo_top_ahm();
2006 38 100       82 return if not defined $base_ahm_id;
2007 6         15 my $trace_earley_set = $recce_c->_marpa_r_trace_earley_set();
2008 6         39 my $trace_earleme = $recce_c->earleme($trace_earley_set);
2009 6         17 my $postdot_symbol_id = $recce_c->_marpa_r_postdot_item_symbol();
2010 6         20 my $postdot_symbol_name = $tracer->isy_name($postdot_symbol_id);
2011             # my $predecessor_symbol_id = $recce_c->_marpa_r_leo_predecessor_symbol();
2012 6         17 my $base_origin_set_id = $recce_c->_marpa_r_leo_base_origin();
2013 6         12 my $base_origin_earleme = $recce_c->earleme($base_origin_set_id);
2014              
2015 6         16 my $base_irl_id = $grammar_c->_marpa_g_ahm_irl($base_ahm_id);
2016 6         15 my $base_rule_id = $grammar_c->_marpa_g_source_xrl($base_irl_id);
2017 6         9 my $base_desc;
2018 6 50       12 if (defined $base_rule_id) {
2019 6         19 $base_desc = '[' . $slg->show_dotted_rule($base_rule_id, -2) . ']';
2020             } else {
2021 0         0 $base_desc = 'IRL#' . $base_irl_id;
2022             }
2023              
2024 6         22 my $text = sprintf 'L%d', $trace_earleme;
2025 6         19 my @link_texts = ($base_desc, qq{"$postdot_symbol_name"}, "$base_origin_earleme");
2026 6         17 $text .= ' [' . ( join '; ', @link_texts ) . ']';
2027 6         15 return $text;
2028             }
2029              
2030             sub Marpa::R2::Scanless::R::show_parse_items {
2031 10     10   75 my ( $slr, $ordinal ) = @_;
2032 10         26 my $text = $slr->show_progress($ordinal);
2033 10         30 $text .= $slr->show_leo_items($ordinal);
2034 10         36 return $text;
2035             }
2036              
2037             1;
2038              
2039             # vim: expandtab shiftwidth=4: