File Coverage

blib/lib/Marpa/R2/SLG.pm
Criterion Covered Total %
statement 511 538 94.9
branch 148 196 75.5
condition 37 49 75.5
subroutine 32 33 96.9
pod n/a
total 728 816 89.2


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::G;
17              
18 135     135   2751 use 5.010001;
  135         544  
19 135     135   908 use strict;
  135         362  
  135         3115  
20 135     135   716 use warnings;
  135         333  
  135         5787  
21              
22 135     135   843 use vars qw($VERSION $STRING_VERSION);
  135         386  
  135         12691  
23             $VERSION = '13.002_000';
24             $STRING_VERSION = $VERSION;
25             ## no critic(BuiltinFunctions::ProhibitStringyEval)
26             $VERSION = eval $VERSION;
27             ## use critic
28              
29             package Marpa::R2::Internal::Scanless::G;
30              
31 135     135   1037 use Scalar::Util 'blessed';
  135         1660  
  135         10711  
32 135     135   1013 use English qw( -no_match_vars );
  135         395  
  135         1006  
33              
34             # names of packages for strings
35             our $PACKAGE = 'Marpa::R2::Scanless::G';
36              
37             sub Marpa::R2::Internal::Scanless::meta_grammar {
38              
39 75     75   301 my $meta_slg = bless [], 'Marpa::R2::Scanless::G';
40 75         427 state $hashed_metag = Marpa::R2::Internal::MetaG::hashed_grammar();
41 75         450 $meta_slg->[Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS] = 0;
42 75         769 Marpa::R2::Internal::Scanless::G::hash_to_runtime( $meta_slg,
43             $hashed_metag,
44             { bless_package => 'Marpa::R2::Internal::MetaAST_Nodes' } );
45              
46 75         545 my $thick_g1_grammar =
47             $meta_slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
48 75         260 my @mask_by_rule_id;
49             $mask_by_rule_id[$_] = $thick_g1_grammar->_rule_mask($_)
50 75         586 for $thick_g1_grammar->rule_ids();
51 75         574 $meta_slg->[Marpa::R2::Internal::Scanless::G::MASK_BY_RULE_ID] =
52             \@mask_by_rule_id;
53 75         267 $meta_slg->[Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS] = 0;
54              
55 75         542 return $meta_slg;
56              
57             } ## end sub Marpa::R2::Internal::Scanless::meta_grammar
58              
59             sub Marpa::R2::Scanless::G::new {
60 203     203   80678 my ( $class, @hash_ref_args ) = @_;
61              
62 203         638 my $slg = [];
63 203         607 bless $slg, $class;
64              
65 203         933 my ($dsl, $g1_args) = Marpa::R2::Internal::Scanless::G::set ( $slg, 'new', @hash_ref_args );
66 203         1481 my $ast = Marpa::R2::Internal::MetaAST->new( $dsl );
67 200         1189 my $hashed_ast = $ast->ast_to_hash();
68 200         1307 Marpa::R2::Internal::Scanless::G::hash_to_runtime($slg, $hashed_ast, $g1_args);
69 184         38050 return $slg;
70             } ## end sub Marpa::R2::Scanless::G::new
71              
72             sub Marpa::R2::Scanless::G::set {
73 1     1   1396 my ( $slg, @hash_ref_args ) = @_;
74 1         6 Marpa::R2::Internal::Scanless::G::set ( $slg, 'set', @hash_ref_args );
75 1         3 return $slg;
76             }
77              
78             # The context flag indicates whether this ::set() is called directly by the user;
79             # is for the external constructor; or is for the internal ("meta") constructor.
80             # "Context" flags of this kind
81             # are much decried practice, and for good reason, but in this case
82             # I think it is justified.
83             # This logic really needs to be all in one place, and so a flag
84             # to trigger the minor differences needed by the various calling
85             # contexts is a small price to pay.
86             sub Marpa::R2::Internal::Scanless::G::set {
87 204     204   837 my ( $slg, $method, @hash_ref_args ) = @_;
88              
89             # Other possible grammar options:
90             # default_rank
91             # inaccessible_ok
92             # unproductive_ok
93             # warnings
94              
95             state $copy_to_g1_args =
96 204         598 { map { ( $_, 1 ); }
  284         908  
97             qw(trace_file_handle action_object default_action bless_package) };
98             state $set_method_args =
99 204         555 { map { ( $_, 1 ); } qw(trace_file_handle trace_terminals) };
  142         484  
100             state $new_method_args = {
101 204         581 map { ( $_, 1 ); } qw(source trace_terminals), keys %{$copy_to_g1_args}
  426         874  
  71         320  
102             };
103 204         801 for my $args (@hash_ref_args) {
104 204         608 my $ref_type = ref $args;
105 204 50       834 if ( not $ref_type ) {
106 0         0 Marpa::R2::exception( q{$slg->}
107             . $method
108             . qq{() expects args as ref to HASH; got non-reference instead}
109             );
110             } ## end if ( not $ref_type )
111 204 50       971 if ( $ref_type ne 'HASH' ) {
112 0         0 Marpa::R2::exception( q{$slg->}
113             . $method
114             . qq{() expects args as ref to HASH, got ref to $ref_type instead}
115             );
116             } ## end if ( $ref_type ne 'HASH' )
117             } ## end for my $args (@hash_ref_args)
118              
119 204         586 my %flat_args = ();
120 204         590 for my $hash_ref (@hash_ref_args) {
121 204         427 ARG: for my $arg_name ( keys %{$hash_ref} ) {
  204         804  
122 243         970 $flat_args{$arg_name} = $hash_ref->{$arg_name};
123             }
124             }
125              
126 204         501 my $ok_args = $set_method_args;
127 204 100       813 $ok_args = $new_method_args if $method eq 'new';
128 204         725 my @bad_args = grep { not $ok_args->{$_} } keys %flat_args;
  243         1036  
129 204 50       1121 if ( scalar @bad_args ) {
130 0         0 Marpa::R2::exception(
131             q{Bad named argument(s) to $slg->}
132             . $method
133             . q{() method: }
134             . join q{ },
135             @bad_args
136             );
137             } ## end if ( scalar @bad_args )
138              
139 204         478 my $dsl;
140 204 100       790 if ( $method eq 'new' ) {
141 203         464 state $arg_name = 'source';
142 203         549 $dsl = $flat_args{$arg_name};
143 203 50       704 Marpa::R2::exception(
144             qq{Marpa::R2::Scanless::G::new() called without a "$arg_name" argument}
145             ) if not defined $dsl;
146 203         580 my $ref_type = ref $dsl;
147 203 50       755 if ( $ref_type ne 'SCALAR' ) {
148 0 0       0 my $desc = $ref_type ? "a ref to $ref_type" : 'not a ref';
149 0         0 Marpa::R2::exception(
150             qq{'$arg_name' name argument to Marpa::R2::Scanless::G->new() is $desc\n},
151             " It should be a ref to a string\n"
152             );
153             } ## end if ( $ref_type ne 'SCALAR' )
154 203 50       426 if ( not defined ${$dsl} ) {
  203         763  
155 0         0 Marpa::R2::exception(
156             qq{'$arg_name' name argument to Marpa::R2::Scanless::G->new() is a ref to a an undef\n},
157             " It should be a ref to a string\n"
158             );
159             } ## end if ( $ref_type ne 'SCALAR' )
160             } ## end if ( $method eq 'new' )
161              
162             # A bit hack-ish, but some named args will be copies straight to a member of
163             # the Scanless::G class, so this maps named args to the index of the array
164             # that holds the members.
165 204         623 state $copy_arg_to_index = {
166             trace_file_handle => Marpa::R2::Internal::Scanless::G::TRACE_FILE_HANDLE,
167             trace_terminals => Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS
168             };
169              
170 204         651 ARG: for my $arg_name ( keys %flat_args ) {
171 243         572 my $index = $copy_arg_to_index->{$arg_name};
172 243 100       1016 next ARG if not defined $index;
173 1         3 my $value = $flat_args{$arg_name};
174 1         3 $slg->[$index] = $value;
175             } ## end ARG: for my $arg_name ( keys %flat_args )
176              
177             # Normalize trace_terminals
178 204 100       2185 $slg->[Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS] = 0
179             if not Scalar::Util::looks_like_number(
180             $slg->[Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS] );
181              
182             # Trace file handle needs to be populated downwards
183 204 100       1037 if ( defined( my $trace_file_handle = $flat_args{trace_file_handle} ) ) {
184             GRAMMAR:
185 1         3 for my $naif_grammar (
186             $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR],
187 1         6 @{ $slg->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS] }
188             )
189             {
190 2 50       6 next GRAMMAR if not defined $naif_grammar;
191 2         7 $naif_grammar->set( { trace_file_handle => $trace_file_handle } );
192             } ## end GRAMMAR: for my $naif_grammar ( $slg->[...])
193             } ## end if ( defined( my $trace_file_handle = $flat_args{...}))
194              
195 204 100       765 if ( $method eq 'new' ) {
196              
197             # Prune flat args of all those named args which are NOT to be copied
198             # into the NAIF recce args
199 203         622 for my $arg_name ( keys %flat_args ) {
200             delete $flat_args{$arg_name}
201 242 100       1034 if not $copy_to_g1_args->{$arg_name};
202             }
203              
204             # trace file handle must always be defined
205 203   50     1549 $slg->[Marpa::R2::Internal::Scanless::G::TRACE_FILE_HANDLE] //= \*STDERR;
206              
207 203         938 return ($dsl, \%flat_args);
208             } ## end if ( $method eq 'new' )
209              
210 1         4 return;
211              
212             } ## end sub Marpa::R2::Internal::Scanless::G::set
213              
214             sub Marpa::R2::Internal::Scanless::G::hash_to_runtime {
215 275     275   1046 my ( $slg, $hashed_source, $g1_args ) = @_;
216              
217 275         856 my $trace_terminals =
218             $slg->[Marpa::R2::Internal::Scanless::G::TRACE_TERMINALS];
219              
220             # Pre-lexer G1 processing
221              
222             my $start_lhs = $hashed_source->{'start_lhs'}
223 275   66     1476 // $hashed_source->{'first_lhs'};
224 275 50       1028 Marpa::R2::exception('No rules in SLIF grammar')
225             if not defined $start_lhs;
226 275         1607 Marpa::R2::Internal::MetaAST::start_rule_create( $hashed_source,
227             $start_lhs );
228              
229 275         935 $slg->[Marpa::R2::Internal::Scanless::G::CACHE_RULEIDS_BY_LHS_NAME] = {};
230             $slg->[Marpa::R2::Internal::Scanless::G::DEFAULT_G1_START_ACTION] =
231 275         937 $hashed_source->{'default_g1_start_action'};
232              
233             my $trace_fh =
234             $slg->[Marpa::R2::Internal::Scanless::G::TRACE_FILE_HANDLE] =
235 275   50     1888 $g1_args->{trace_file_handle} // \*STDERR;
236              
237             my $if_inaccessible_default =
238 275   100     1732 $hashed_source->{defaults}->{if_inaccessible} // 'warn';
239              
240             # Prepare the arguments for the G1 grammar
241 275         868 $g1_args->{rules} = $hashed_source->{rules}->{G1};
242 275         798 $g1_args->{symbols} = $hashed_source->{symbols}->{G1};
243 275         637 state $g1_target_symbol = '[:start]';
244 275         827 $g1_args->{start} = $g1_target_symbol;
245 275         1121 $g1_args->{'_internal_'} =
246             { 'if_inaccessible' => $if_inaccessible_default };
247              
248 275         2003 my $thick_g1_grammar = Marpa::R2::Grammar->new($g1_args);
249 271         1382 my $g1_tracer = $thick_g1_grammar->tracer();
250 271         1175 my $g1_thin = $g1_tracer->grammar();
251              
252 271         729 my $symbol_ids_by_event_name_and_type = {};
253 271         744 $slg->[
254             Marpa::R2::Internal::Scanless::G::SYMBOL_IDS_BY_EVENT_NAME_AND_TYPE]
255             = $symbol_ids_by_event_name_and_type;
256              
257 271         656 my $completion_events_by_name = $hashed_source->{completion_events};
258 271         880 my $completion_events_by_id =
259             $slg->[Marpa::R2::Internal::Scanless::G::COMPLETION_EVENT_BY_ID] = [];
260 271         589 for my $symbol_name ( keys %{$completion_events_by_name} ) {
  271         1225  
261             my ( $event_name, $is_active ) =
262 54         97 @{ $completion_events_by_name->{$symbol_name} };
  54         136  
263 54         156 my $symbol_id = $g1_tracer->symbol_by_name($symbol_name);
264 54 50       185 if ( not defined $symbol_id ) {
265 0         0 Marpa::R2::exception(
266             "Completion event defined for non-existent symbol: $symbol_name\n"
267             );
268             }
269              
270             # Must be done before precomputation
271 54         163 $g1_thin->symbol_is_completion_event_set( $symbol_id, 1 );
272 54 100       140 $g1_thin->completion_symbol_activate( $symbol_id, 0 )
273             if not $is_active;
274 54         124 $slg->[Marpa::R2::Internal::Scanless::G::COMPLETION_EVENT_BY_ID]
275             ->[$symbol_id] = $event_name;
276             push
277 54         80 @{ $symbol_ids_by_event_name_and_type->{$event_name}->{completion}
278 54         287 }, $symbol_id;
279             } ## end for my $symbol_name ( keys %{$completion_events_by_name...})
280              
281 271         785 my $nulled_events_by_name = $hashed_source->{nulled_events};
282 271         790 my $nulled_events_by_id =
283             $slg->[Marpa::R2::Internal::Scanless::G::NULLED_EVENT_BY_ID] = [];
284 271         530 for my $symbol_name ( keys %{$nulled_events_by_name} ) {
  271         890  
285             my ( $event_name, $is_active ) =
286 46         66 @{ $nulled_events_by_name->{$symbol_name} };
  46         92  
287 46         110 my $symbol_id = $g1_tracer->symbol_by_name($symbol_name);
288 46 50       99 if ( not defined $symbol_id ) {
289 0         0 Marpa::R2::exception(
290             "nulled event defined for non-existent symbol: $symbol_name\n"
291             );
292             }
293              
294             # Must be done before precomputation
295 46         132 $g1_thin->symbol_is_nulled_event_set( $symbol_id, 1 );
296 46 100       106 $g1_thin->nulled_symbol_activate( $symbol_id, 0 ) if not $is_active;
297 46         76 $slg->[Marpa::R2::Internal::Scanless::G::NULLED_EVENT_BY_ID]
298             ->[$symbol_id] = $event_name;
299 46         66 push @{ $symbol_ids_by_event_name_and_type->{$event_name}->{nulled} },
  46         195  
300             $symbol_id;
301             } ## end for my $symbol_name ( keys %{$nulled_events_by_name} )
302              
303 271         690 my $prediction_events_by_name = $hashed_source->{prediction_events};
304 271         776 my $prediction_events_by_id =
305             $slg->[Marpa::R2::Internal::Scanless::G::PREDICTION_EVENT_BY_ID] = [];
306 271         545 for my $symbol_name ( keys %{$prediction_events_by_name} ) {
  271         889  
307             my ( $event_name, $is_active ) =
308 52         77 @{ $prediction_events_by_name->{$symbol_name} };
  52         107  
309 52         150 my $symbol_id = $g1_tracer->symbol_by_name($symbol_name);
310 52 50       116 if ( not defined $symbol_id ) {
311 0         0 Marpa::R2::exception(
312             "prediction event defined for non-existent symbol: $symbol_name\n"
313             );
314             }
315              
316             # Must be done before precomputation
317 52         145 $g1_thin->symbol_is_prediction_event_set( $symbol_id, 1 );
318 52 100       114 $g1_thin->prediction_symbol_activate( $symbol_id, 0 )
319             if not $is_active;
320 52         94 $slg->[Marpa::R2::Internal::Scanless::G::PREDICTION_EVENT_BY_ID]
321             ->[$symbol_id] = $event_name;
322             push
323 52         72 @{ $symbol_ids_by_event_name_and_type->{$event_name}->{prediction}
324 52         227 }, $symbol_id;
325             } ## end for my $symbol_name ( keys %{$prediction_events_by_name...})
326              
327 271         848 my $lexeme_events_by_id =
328             $slg->[Marpa::R2::Internal::Scanless::G::LEXEME_EVENT_BY_ID] = [];
329              
330 271 100       1286 if (defined(
331             my $precompute_error =
332             Marpa::R2::Internal::Grammar::slif_precompute(
333             $thick_g1_grammar)
334             )
335             )
336             {
337 1 50       5 if ( $precompute_error == $Marpa::R2::Error::UNPRODUCTIVE_START ) {
338              
339             # Maybe someday improve this by finding the start rule and showing
340             # its RHS -- for now it is clear enough
341 1         8 Marpa::R2::exception(qq{Unproductive start symbol});
342             } ## end if ( $precompute_error == ...)
343             Marpa::R2::exception(
344 0         0 'Internal errror: unnkown precompute error code ',
345             $precompute_error );
346             } ## end if ( defined( my $precompute_error = ...))
347              
348             # Find out the list of lexemes according to G1
349 267         828 my %g1_id_by_lexeme_name = ();
350 267         1745 SYMBOL: for my $symbol_id ( 0 .. $g1_thin->highest_symbol_id() ) {
351              
352             # Not a lexeme, according to G1
353 13271 100       27324 next SYMBOL if not $g1_thin->symbol_is_terminal($symbol_id);
354              
355 7989         14982 my $symbol_name = $g1_tracer->symbol_name($symbol_id);
356 7989         14880 $g1_id_by_lexeme_name{$symbol_name} = $symbol_id;
357              
358             } ## end SYMBOL: for my $symbol_id ( 0 .. $g1_thin->highest_symbol_id(...))
359              
360             # A first phase of applying defaults
361 267         1188 my $discard_default_adverbs = $hashed_source->{discard_default_adverbs};
362 267         789 my $lexeme_declarations = $hashed_source->{lexeme_declarations};
363 267         684 my $lexeme_default_adverbs = $hashed_source->{lexeme_default_adverbs};
364 267   100     1303 my $latm_default_value = $lexeme_default_adverbs->{latm} // 0;
365              
366             # Current lexeme data is spread out in many places.
367             # Change so that it all resides in this hash, indexed by
368             # name
369 267         696 my %lexeme_data = ();
370              
371             # Determine "latm" status
372 267         1920 LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name ) {
373 7989         10743 my $declarations = $lexeme_declarations->{$lexeme_name};
374 7989   100     18063 my $latm_value = $declarations->{latm} // $latm_default_value;
375 7989         19851 $lexeme_data{$lexeme_name}{latm} = $latm_value;
376             }
377              
378             # Lexers
379              
380 267         1182 my $lexer_id = 0;
381 267         704 my $lexer_name = 'L0';
382              
383 267         636 my %lexer_id_by_name = ();
384 267         590 my %thick_grammar_by_lexer_name = ();
385 267         602 my @discard_event_by_lexer_rule_id = ();
386 267         543 my %lexer_and_rule_to_g1_lexeme = ();
387 267         510 my %character_class_table_by_lexer_name = ();
388 267         548 state $lex_start_symbol_name = '[:start_lex]';
389 267         520 state $discard_symbol_name = '[:discard]';
390              
391 267         791 my $lexer_rules = $hashed_source->{rules}->{$lexer_name};
392 267         607 my $character_class_hash = $hashed_source->{character_classes};
393 267         726 my $lexer_symbols = $hashed_source->{symbols}->{'L'};
394              
395             # If no lexer rules, fake a lexer
396             # Fake a lexer -- it discards symbols in character classes which
397             # never matches
398 267 100       927 if ( not $lexer_rules ) {
399 2         11 $character_class_hash = { '[[^\\d\\D]]' => [ '[^\\d\\D]', '' ] };
400 2         14 $lexer_rules = [
401             { 'rhs' => [ '[[^\\d\\D]]' ],
402             'lhs' => '[:discard]',
403             'symbol_as_event' => '[^\\d\\D]',
404             'description' => 'Discard rule for <[[^\\d\\D]]>'
405             },
406             ];
407 2         15 $lexer_symbols = {
408             '[:discard]' => {
409             'display_form' => ':discard',
410             'description' => 'Internal LHS for lexer "L0" discard'
411             },
412             '[[^\\d\\D]]' => {
413             'dsl_form' => '[^\\d\\D]',
414             'display_form' => '[^\\d\\D]',
415             'description' => 'Character class: [^\\d\\D]'
416             }
417             };
418             } ## end if ( not $lexer_rules )
419              
420 267         637 my %lex_lhs = ();
421 267         623 my %lex_rhs = ();
422 267         500 my %lex_separator = ();
423 267         540 my %lexer_rule_by_tag = ();
424              
425 267         653 my $rule_tag = 'rule0';
426 267         590 for my $lex_rule ( @{$lexer_rules} ) {
  267         765  
427 12463         24388 $lex_rule->{tag} = ++$rule_tag;
428 12463         15376 my %lex_rule_copy = %{$lex_rule};
  12463         57278  
429 12463         35881 $lexer_rule_by_tag{$rule_tag} = \%lex_rule_copy;
430 12463         17203 delete $lex_rule->{event};
431 12463         15425 delete $lex_rule->{symbol_as_event};
432 12463         22145 $lex_lhs{ $lex_rule->{lhs} } = 1;
433 12463         15235 $lex_rhs{$_} = 1 for @{ $lex_rule->{rhs} };
  12463         41574  
434 12463 100       29535 if ( defined( my $separator = $lex_rule->{separator} ) ) {
435 150         906 $lex_separator{$separator} = 1;
436             }
437             } ## end for my $lex_rule ( @{$lexer_rules} )
438              
439 267         995 my %this_lexer_symbols = ();
440             SYMBOL:
441 267         4575 for my $symbol_name ( ( keys %lex_lhs ), ( keys %lex_rhs ),
442             ( keys %lex_separator ) )
443             {
444 18574         25423 my $symbol_data = $lexer_symbols->{$symbol_name};
445 18574 100       35973 $this_lexer_symbols{$symbol_name} = $symbol_data
446             if defined $symbol_data;
447             } ## end SYMBOL: for my $symbol_name ( ( keys %lex_lhs ), ( keys %lex_rhs...))
448              
449 8176         14411 my %is_lexeme_in_this_lexer = map { $_ => 1 }
450 267   100     3132 grep { not $lex_rhs{$_} and not $lex_separator{$_} }
  10732         26294  
451             keys %lex_lhs;
452              
453 267         2815 my @lex_lexeme_names = keys %is_lexeme_in_this_lexer;
454              
455 267 50       1088 Marpa::R2::exception( "No lexemes in lexer: $lexer_name\n",
456             " An SLIF grammar must have at least one lexeme\n" )
457             if not scalar @lex_lexeme_names;
458              
459             # Do I need this?
460             my @unproductive =
461 0         0 map {"<$_>"}
462 267   66     1709 grep { not $lex_lhs{$_} and not $_ =~ /\A \[\[ /xms }
  7842         24582  
463             ( keys %lex_rhs, keys %lex_separator );
464 267 50       1372 if (@unproductive) {
465 0         0 Marpa::R2::exception( 'Unproductive lexical symbols: ',
466             join q{ }, @unproductive );
467             }
468              
469             $this_lexer_symbols{$lex_start_symbol_name}->{display_form} =
470 267         1181 ':start_lex';
471             $this_lexer_symbols{$lex_start_symbol_name}->{description} =
472 267         1211 'Internal L0 (lexical) start symbol';
473 267         4233 push @{$lexer_rules}, map {
474 267         612 ;
475 8176         34299 { description => "Internal lexical start rule for <$_>",
476             lhs => $lex_start_symbol_name,
477             rhs => [$_]
478             }
479             } sort keys %is_lexeme_in_this_lexer;
480              
481             # Prepare the arguments for the lex grammar
482 267         1532 my %lex_args = ();
483 267         873 $lex_args{trace_file_handle} = $trace_fh;
484 267         796 $lex_args{start} = $lex_start_symbol_name;
485 267         1125 $lex_args{'_internal_'} =
486             { 'if_inaccessible' => $if_inaccessible_default };
487 267         719 $lex_args{rules} = $lexer_rules;
488 267         750 $lex_args{symbols} = \%this_lexer_symbols;
489              
490             # Create the thick lex grammar
491 267         1534 my $lex_grammar = Marpa::R2::Grammar->new( \%lex_args );
492 267         1313 $thick_grammar_by_lexer_name{$lexer_name} = $lex_grammar;
493 267         1193 my $lex_tracer = $lex_grammar->tracer();
494 267         1136 my $lex_thin = $lex_tracer->grammar();
495              
496 267   100     1180 my $lex_discard_symbol_id =
497             $lex_tracer->symbol_by_name($discard_symbol_name) // -1;
498 267         715 my @lex_lexeme_to_g1_symbol;
499 267         4927 $lex_lexeme_to_g1_symbol[$_] = -1 for 0 .. $g1_thin->highest_symbol_id();
500              
501 267         1245 LEXEME_NAME: for my $lexeme_name (@lex_lexeme_names) {
502 8175 100       15241 next LEXEME_NAME if $lexeme_name eq $discard_symbol_name;
503 7988 50       13061 next LEXEME_NAME if $lexeme_name eq $lex_start_symbol_name;
504 7988         11967 my $g1_symbol_id = $g1_id_by_lexeme_name{$lexeme_name};
505 7988 100       13065 if ( not defined $g1_symbol_id ) {
506 4         25 Marpa::R2::exception(
507             qq{<$lexeme_name> is a lexeme but it is not a legal lexeme in G1:\n},
508             qq{ Lexemes must be G1 symbols that do not appear on a G1 LHS.\n}
509             );
510             }
511 7984 100       20366 if ( not $g1_thin->symbol_is_accessible($g1_symbol_id) ) {
512 2         12 my $message =
513             "A lexeme in lexer $lexer_name is not accessible from the G1 start symbol: $lexeme_name";
514 2 50       6 say {$trace_fh} $message
  0         0  
515             if $if_inaccessible_default eq 'warn';
516 2 50       7 Marpa::R2::exception($message)
517             if $if_inaccessible_default eq 'fatal';
518             } ## end if ( not $g1_thin->symbol_is_accessible($g1_symbol_id...))
519 7984         15964 my $lex_symbol_id = $lex_tracer->symbol_by_name($lexeme_name);
520 7984         29072 $lexeme_data{$lexeme_name}{lexers}{$lexer_name}{'id'} =
521             $lex_symbol_id;
522 7984         13943 $lex_lexeme_to_g1_symbol[$lex_symbol_id] = $g1_symbol_id;
523             } ## end LEXEME_NAME: for my $lexeme_name (@lex_lexeme_names)
524              
525 263         870 my @lex_rule_to_g1_lexeme;
526 263         1075 my $lex_start_symbol_id =
527             $lex_tracer->symbol_by_name($lex_start_symbol_name);
528 263         1688 RULE_ID: for my $rule_id ( 0 .. $lex_thin->highest_rule_id() ) {
529 20627         34372 my $lhs_id = $lex_thin->rule_lhs($rule_id);
530 20627 100       33786 if ( $lhs_id == $lex_discard_symbol_id ) {
531 301         862 $lex_rule_to_g1_lexeme[$rule_id] = -2;
532 301         671 next RULE_ID;
533             }
534 20326 100       32801 if ( $lhs_id != $lex_start_symbol_id ) {
535 12156         15852 $lex_rule_to_g1_lexeme[$rule_id] = -1;
536 12156         16638 next RULE_ID;
537             }
538 8170         14464 my $lexer_lexeme_id = $lex_thin->rule_rhs( $rule_id, 0 );
539 8170 100       13872 if ( $lexer_lexeme_id == $lex_discard_symbol_id ) {
540 187         592 $lex_rule_to_g1_lexeme[$rule_id] = -1;
541 187         499 next RULE_ID;
542             }
543 7983   50     13964 my $lexeme_id = $lex_lexeme_to_g1_symbol[$lexer_lexeme_id] // -1;
544 7983         11703 $lex_rule_to_g1_lexeme[$rule_id] = $lexeme_id;
545 7983 50       12985 next RULE_ID if $lexeme_id < 0;
546 7983         15939 my $lexeme_name = $g1_tracer->symbol_name($lexeme_id);
547              
548             # If 1 is the default, we don't need an assertion
549 7983 100       16955 next RULE_ID if not $lexeme_data{$lexeme_name}{latm};
550              
551             my $assertion_id =
552 7550         12341 $lexeme_data{$lexeme_name}{lexers}{$lexer_name}{'assertion'};
553 7550 50       12389 if ( not defined $assertion_id ) {
554 7550         14136 $assertion_id = $lex_thin->zwa_new(0);
555              
556 7550 50       13311 if ( $trace_terminals >= 2 ) {
557 0         0 say {$trace_fh} "Assertion $assertion_id defaults to 0";
  0         0  
558             }
559              
560 7550         12810 $lexeme_data{$lexeme_name}{lexers}{$lexer_name}{'assertion'} =
561             $assertion_id;
562             } ## end if ( not defined $assertion_id )
563 7550         18763 $lex_thin->zwa_place( $assertion_id, $rule_id, 0 );
564 7550 50       15216 if ( $trace_terminals >= 2 ) {
565 0         0 say {$trace_fh}
  0         0  
566             "Assertion $assertion_id applied to $lexer_name rule ",
567             slg_rule_show( $slg, $rule_id, $lex_grammar );
568             }
569             } ## end RULE_ID: for my $rule_id ( 0 .. $lex_thin->highest_rule_id() )
570              
571 263         1601 Marpa::R2::Internal::Grammar::slif_precompute($lex_grammar);
572              
573 263         1048 my @class_table = ();
574              
575             CLASS_SYMBOL:
576 263         706 for my $class_symbol ( sort keys %{$character_class_hash} ) {
  263         4697  
577 5282         11983 my $symbol_id = $lex_tracer->symbol_by_name($class_symbol);
578 5282 50       10099 next CLASS_SYMBOL if not defined $symbol_id;
579 5282         8726 my $cc_components = $character_class_hash->{$class_symbol};
580 5282         10229 my ( $compiled_re, $error ) =
581             Marpa::R2::Internal::MetaAST::char_class_to_re($cc_components);
582 5282 50       10082 if ( not $compiled_re ) {
583 0         0 $error =~ s/^/ /gxms; #indent all lines
584 0         0 Marpa::R2::exception(
585             "Failed belatedly to evaluate character class\n", $error );
586             }
587 5282         12985 push @class_table, [ $symbol_id, $compiled_re ];
588             } ## end CLASS_SYMBOL: for my $class_symbol ( sort keys %{...})
589 263         1524 $character_class_table_by_lexer_name{$lexer_name} = \@class_table;
590              
591 263         932 $lexer_and_rule_to_g1_lexeme{$lexer_name} = \@lex_rule_to_g1_lexeme;
592              
593             # Apply defaults to determine the discard event for every
594             # rule id of the lexer.
595              
596 263         842 my $default_discard_event = $discard_default_adverbs->{event};
597 263         1648 RULE_ID: for my $rule_id ( 0 .. $lex_thin->highest_rule_id() ) {
598 20627         37240 my $tag = $lex_grammar->tag($rule_id);
599 20627 100       37802 next RULE_ID if not defined $tag;
600 12457         15059 my $event;
601             FIND_EVENT: {
602 12457         15298 $event = $lexer_rule_by_tag{$tag}->{event};
  12457         22553  
603 12457 100       20551 last FIND_EVENT if defined $event;
604 12406         21756 my $lhs_id = $lex_thin->rule_lhs($rule_id);
605 12406 100       22942 last FIND_EVENT if $lhs_id != $lex_discard_symbol_id;
606 250         606 $event = $default_discard_event;
607             } ## end FIND_EVENT:
608 12457 100       23783 next RULE_ID if not defined $event;
609              
610 60         156 my ( $event_name, $event_starts_active ) = @{$event};
  60         168  
611 60 100       202 if ( $event_name eq q{'symbol} ) {
612             my @event = (
613             $lexer_rule_by_tag{$tag}->{symbol_as_event},
614 15         52 $event_starts_active
615             );
616 15         27 $discard_event_by_lexer_rule_id[$rule_id] = \@event;
617 15         31 next RULE_ID;
618             } ## end if ( $event_name eq q{'symbol} )
619 45 50       171 if ( ( substr $event_name, 0, 1 ) ne q{'} ) {
620 45         96 $discard_event_by_lexer_rule_id[$rule_id] = $event;
621 45         106 next RULE_ID;
622             }
623             Marpa::R2::exception(
624 0         0 qq{Discard event has unknown name: "$event_name"}
625             );
626              
627             } ## end RULE_ID: for my $rule_id ( 0 .. $lex_thin->highest_rule_id() )
628              
629             # Post-lexer G1 processing
630              
631 263         1212 my $thick_L0 = $thick_grammar_by_lexer_name{'L0'};
632 263         991 my $thin_L0 = $thick_L0->[Marpa::R2::Internal::Grammar::C];
633 263         1301 my $thin_slg = $slg->[Marpa::R2::Internal::Scanless::G::C] =
634             Marpa::R2::Thin::SLG->new( $thin_L0, $g1_tracer->grammar() );
635              
636             # Relies on default lexer being given number zero
637 263         1027 $lexer_id_by_name{'L0'} = 0;
638              
639 263         2169 LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name ) {
640             Marpa::R2::exception(
641             "A lexeme in G1 is not a lexeme in any of the lexers: $lexeme_name"
642 7987 100       14735 ) if not defined $lexeme_data{$lexeme_name}{'lexers'};
643             }
644              
645             # At this point we know which symbols are lexemes.
646             # So now let's check for inconsistencies
647              
648             # Check for lexeme declarations for things which are not lexemes
649 259         978 for my $lexeme_name ( keys %{$lexeme_declarations} ) {
  259         1104  
650             Marpa::R2::exception(
651             "Symbol <$lexeme_name> is declared as a lexeme, but it is not used as one.\n"
652 59 50       215 ) if not defined $g1_id_by_lexeme_name{$lexeme_name};
653             }
654              
655             # Now that we know the lexemes, check attempts to defined a
656             # completion or a nulled event for one
657 259         603 for my $symbol_name ( keys %{$completion_events_by_name} ) {
  259         1227  
658             Marpa::R2::exception(
659             "A completion event is declared for <$symbol_name>, but it is a lexeme.\n",
660             " Completion events are only valid for symbols on the LHS of G1 rules.\n"
661 54 50       159 ) if defined $g1_id_by_lexeme_name{$symbol_name};
662             } ## end for my $symbol_name ( keys %{$completion_events_by_name...})
663              
664 259         531 for my $symbol_name ( keys %{$nulled_events_by_name} ) {
  259         796  
665             Marpa::R2::exception(
666             "A nulled event is declared for <$symbol_name>, but it is a G1 lexeme.\n",
667             " nulled events are only valid for symbols on the LHS of G1 rules.\n"
668 46 50       98 ) if defined $g1_id_by_lexeme_name{$symbol_name};
669             } ## end for my $symbol_name ( keys %{$nulled_events_by_name} )
670              
671             # Mark the lexemes, and set their data
672             # Now that we have created the SLG, we can set the latm value,
673             # already determined above.
674 259         1534 LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name ) {
675 7979         11124 my $g1_lexeme_id = $g1_id_by_lexeme_name{$lexeme_name};
676 7979         10618 my $declarations = $lexeme_declarations->{$lexeme_name};
677 7979   100     18825 my $priority = $declarations->{priority} // 0;
678 7979         16137 $thin_slg->g1_lexeme_set( $g1_lexeme_id, $priority );
679 7979   50     14339 my $latm_value = $lexeme_data{$lexeme_name}{latm} // 0;
680 7979         16966 $thin_slg->g1_lexeme_latm_set( $g1_lexeme_id, $latm_value );
681 7979         10333 my $pause_value = $declarations->{pause};
682 7979 100       15848 if ( defined $pause_value ) {
683 54         213 $thin_slg->g1_lexeme_pause_set( $g1_lexeme_id, $pause_value );
684 54         78 my $is_active = 1;
685              
686 54 100       152 if ( defined( my $event_data = $declarations->{'event'} ) ) {
687 49         79 my $event_name;
688 49         84 ( $event_name, $is_active ) = @{$event_data};
  49         115  
689 49         127 $lexeme_events_by_id->[$g1_lexeme_id] = $event_name;
690 49         83 push @{ $symbol_ids_by_event_name_and_type->{$event_name}
691 49         224 ->{lexeme} }, $g1_lexeme_id;
692             } ## end if ( defined( my $event_data = $declarations->{'event'...}))
693              
694 54         242 $thin_slg->g1_lexeme_pause_activate( $g1_lexeme_id, $is_active );
695             } ## end if ( defined $pause_value )
696              
697             } ## end LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name )
698              
699             # Second phase of lexer processing
700 259         1362 my $lexer_rule_to_g1_lexeme = $lexer_and_rule_to_g1_lexeme{$lexer_name};
701              
702 259         637 RULE_ID: for my $lexer_rule_id ( 0 .. $#{$lexer_rule_to_g1_lexeme} ) {
  259         1048  
703 20617         26135 my $g1_lexeme_id = $lexer_rule_to_g1_lexeme->[$lexer_rule_id];
704 20617         35704 my $lexeme_name = $g1_tracer->symbol_name($g1_lexeme_id);
705             my $assertion_id =
706 20617   100     43802 $lexeme_data{$lexeme_name}{lexers}{$lexer_name}{'assertion'}
707             // -1;
708 20617         42305 $thin_slg->lexer_rule_to_g1_lexeme_set( $lexer_rule_id,
709             $g1_lexeme_id, $assertion_id );
710 20617         26026 my $discard_event = $discard_event_by_lexer_rule_id[$lexer_rule_id];
711 20617 100       38219 if ( defined $discard_event ) {
712 60         112 my ( $event_name, $is_active ) = @{$discard_event};
  60         158  
713 60         148 $slg->[
714             Marpa::R2::Internal::Scanless::G::DISCARD_EVENT_BY_LEXER_RULE
715             ]->[$lexer_rule_id] = $event_name;
716 60         104 push @{ $symbol_ids_by_event_name_and_type->{$event_name}
717 60         328 ->{discard} }, $lexer_rule_id;
718 60         221 $thin_slg->discard_event_set( $lexer_rule_id, 1 );
719 60 100       226 $thin_slg->discard_event_activate( $lexer_rule_id, 1 )
720             if $is_active;
721             } ## end if ( defined $discard_event )
722             } ## end RULE_ID: for my $lexer_rule_id ( 0 .. $#{$lexer_rule_to_g1_lexeme...})
723              
724             # Second phase of G1 processing
725              
726 259         1928 $thin_slg->precompute();
727 259         734 $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR] =
728             $thick_g1_grammar;
729              
730             # More lexer processing
731             # Determine events by lexer rule, applying the defaults
732              
733             {
734 259         495 my $character_class_table =
735 259         652 $character_class_table_by_lexer_name{$lexer_name};
736 259         716 $slg->[Marpa::R2::Internal::Scanless::G::CHARACTER_CLASS_TABLES]
737             ->[$lexer_id] = $character_class_table;
738             $slg->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
739 259         851 ->[$lexer_id] = $thick_grammar_by_lexer_name{$lexer_name};
740             }
741              
742             # This section violates the NAIF interface, directly changing some
743             # of its internal structures.
744             #
745             # Some lexeme default adverbs are applied in earlier phases.
746             #
747             APPLY_DEFAULT_LEXEME_ADVERBS: {
748 259 50       565 last APPLY_DEFAULT_LEXEME_ADVERBS if not $lexeme_default_adverbs;
  259         874  
749              
750 259         719 my $action = $lexeme_default_adverbs->{action};
751 259         627 my $g1_symbols =
752             $thick_g1_grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
753             LEXEME:
754 259         1982 for my $lexeme_name ( keys %g1_id_by_lexeme_name ) {
755 7979         11645 my $g1_lexeme_id = $g1_id_by_lexeme_name{$lexeme_name};
756 7979         11799 my $g1_symbol = $g1_symbols->[$g1_lexeme_id];
757 7979 100       18981 next LEXEME if $lexeme_name =~ m/ \] \z/xms;
758 1629   66     5677 $g1_symbol->[Marpa::R2::Internal::Symbol::LEXEME_SEMANTICS] //=
759             $action;
760             } ## end LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name )
761              
762 259         1329 my $blessing = $lexeme_default_adverbs->{bless};
763 259 100       1228 last APPLY_DEFAULT_LEXEME_ADVERBS if not $blessing;
764 79 50       516 last APPLY_DEFAULT_LEXEME_ADVERBS if $blessing eq '::undef';
765              
766             LEXEME:
767 79         1077 for my $lexeme_name ( keys %g1_id_by_lexeme_name ) {
768 7455         10344 my $g1_lexeme_id = $g1_id_by_lexeme_name{$lexeme_name};
769 7455         9344 my $g1_symbol = $g1_symbols->[$g1_lexeme_id];
770 7455 100       19521 next LEXEME if $lexeme_name =~ m/ \] \z/xms;
771 1366 50       2779 if ( $blessing eq '::name' ) {
772 1366 50       3164 if ( $lexeme_name =~ / [^ [:alnum:]] /xms ) {
773 0         0 Marpa::R2::exception(
774             qq{Lexeme blessing by '::name' only allowed if lexeme name is whitespace and alphanumerics\n},
775             qq{ Problematic lexeme was <$lexeme_name>\n}
776             );
777             } ## end if ( $lexeme_name =~ / [^ [:alnum:]] /xms )
778 1366         1876 my $blessing_by_name = $lexeme_name;
779 1366         4036 $blessing_by_name =~ s/[ ]/_/gxms;
780 1366   33     5205 $g1_symbol->[Marpa::R2::Internal::Symbol::BLESSING] //=
781             $blessing_by_name;
782 1366         2370 next LEXEME;
783             } ## end if ( $blessing eq '::name' )
784 0 0       0 if ( $blessing =~ / [\W] /xms ) {
785 0         0 Marpa::R2::exception(
786             qq{Blessing lexeme as '$blessing' is not allowed\n},
787             qq{ Problematic lexeme was <$lexeme_name>\n}
788             );
789             } ## end if ( $blessing =~ / [\W] /xms )
790 0   0     0 $g1_symbol->[Marpa::R2::Internal::Symbol::BLESSING] //= $blessing;
791             } ## end LEXEME: for my $lexeme_name ( keys %g1_id_by_lexeme_name )
792              
793             } ## end APPLY_DEFAULT_LEXEME_ADVERBS:
794              
795 259         21371 return $slg;
796              
797             } ## end sub Marpa::R2::Internal::Scanless::G::hash_to_runtime
798              
799             sub thick_subgrammar_by_name {
800 665     665   1052 my ( $slg, $subgrammar ) = @_;
801              
802             # Allow G0 as legacy synonym for L0
803 665         901 state $grammar_names = { 'G0' => 1, 'G1' => 1, 'L0' => 1 };
804 665   100     2059 $subgrammar //= 'G1';
805              
806             Marpa::R2::exception(qq{No lexer named "$subgrammar"})
807 665 50       1734 if not defined $grammar_names->{$subgrammar};
808              
809 665 100       1957 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR]
810             if $subgrammar eq 'G1';
811              
812 203         430 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]
813             ->[0];
814             } ## end sub thick_subgrammar_by_name
815              
816             sub Marpa::R2::Scanless::G::start_symbol_id {
817 1     1   11 my ( $slg, $rule_id, $subgrammar ) = @_;
818 1         5 return thick_subgrammar_by_name( $slg, $subgrammar )->start_symbol();
819             }
820              
821             sub Marpa::R2::Scanless::G::rule_name {
822 5     5   18 my ( $slg, $rule_id, $subgrammar ) = @_;
823 5         8 return thick_subgrammar_by_name( $slg, $subgrammar )->rule_name($rule_id);
824             }
825              
826             sub Marpa::R2::Scanless::G::rule_expand {
827 60     60   373 my ( $slg, $rule_id, $subgrammar ) = @_;
828 60         129 return thick_subgrammar_by_name( $slg, $subgrammar )->tracer()
829             ->rule_expand($rule_id);
830             }
831              
832             sub Marpa::R2::Scanless::G::symbol_name {
833 171     171   808 my ( $slg, $symbol_id, $subgrammar ) = @_;
834 171         313 return thick_subgrammar_by_name($slg, $subgrammar)->tracer()
835             ->symbol_name($symbol_id);
836             }
837              
838             sub Marpa::R2::Scanless::G::symbol_display_form {
839 139     139   463 my ( $slg, $symbol_id, $subgrammar ) = @_;
840 139         260 return thick_subgrammar_by_name( $slg, $subgrammar )
841             ->symbol_in_display_form($symbol_id);
842             }
843              
844             sub Marpa::R2::Scanless::G::symbol_dsl_form {
845 59     59   275 my ( $slg, $symbol_id, $subgrammar ) = @_;
846 59         91 return thick_subgrammar_by_name( $slg, $subgrammar )
847             ->symbol_dsl_form($symbol_id);
848             }
849              
850             sub Marpa::R2::Scanless::G::symbol_description {
851 59     59   277 my ( $slg, $symbol_id, $subgrammar ) = @_;
852 59         91 return thick_subgrammar_by_name($slg, $subgrammar)
853             ->symbol_description($symbol_id);
854             }
855              
856             sub Marpa::R2::Scanless::G::rule_show
857             {
858 136     136   470 my ( $slg, $rule_id, $subgrammar) = @_;
859 136         281 return slg_rule_show($slg, $rule_id, thick_subgrammar_by_name($slg, $subgrammar));
860             }
861              
862             sub slg_rule_show {
863 136     136   251 my ( $slg, $rule_id, $subgrammar ) = @_;
864 136         341 my $tracer = $subgrammar->tracer();
865 136         220 my $subgrammar_c = $subgrammar->[Marpa::R2::Internal::Grammar::C];
866 136         391 my @symbol_ids = $tracer->rule_expand($rule_id);
867 136 50       391 return if not scalar @symbol_ids;
868             my ( $lhs, @rhs ) =
869 136         223 map { $subgrammar->symbol_in_display_form($_) } @symbol_ids;
  329         661  
870 136         356 my $minimum = $subgrammar_c->sequence_min($rule_id);
871 136         193 my @quantifier = ();
872              
873 136 100       283 if ( defined $minimum ) {
874 8 100       24 @quantifier = ( $minimum <= 0 ? q{*} : q{+} );
875             }
876 136         711 return join q{ }, $lhs, q{::=}, @rhs, @quantifier;
877             } ## end sub slg_rule_show
878              
879             sub Marpa::R2::Scanless::G::show_rules {
880 10     10   3797 my ( $slg, $verbose, $subgrammar ) = @_;
881 10         39 my $text = q{};
882 10   100     59 $verbose //= 0;
883 10   100     52 $subgrammar //= 'G1';
884              
885 10         39 my $thick_grammar = thick_subgrammar_by_name($slg, $subgrammar);
886              
887 10         22 my $rules = $thick_grammar->[Marpa::R2::Internal::Grammar::RULES];
888 10         23 my $grammar_c = $thick_grammar->[Marpa::R2::Internal::Grammar::C];
889              
890 10         23 for my $rule ( @{$rules} ) {
  10         29  
891 183         278 my $rule_id = $rule->[Marpa::R2::Internal::Rule::ID];
892              
893 183         376 my $minimum = $grammar_c->sequence_min($rule_id);
894 183 100       354 my @quantifier =
    100          
895             defined $minimum ? $minimum <= 0 ? (q{*}) : (q{+}) : ();
896 183         338 my $lhs_id = $grammar_c->rule_lhs($rule_id);
897 183         337 my $rule_length = $grammar_c->rule_length($rule_id);
898             my @rhs_ids =
899 183         322 map { $grammar_c->rule_rhs( $rule_id, $_ ) }
  266         559  
900             ( 0 .. $rule_length - 1 );
901             $text .= join q{ }, $subgrammar, "R$rule_id",
902             $thick_grammar->symbol_in_display_form($lhs_id),
903             '::=',
904 183         481 ( map { $thick_grammar->symbol_in_display_form($_) } @rhs_ids ),
  266         506  
905             @quantifier;
906 183         325 $text .= "\n";
907              
908 183 100       391 if ( $verbose >= 2 ) {
909              
910 48         95 my $description = $rule->[Marpa::R2::Internal::Rule::DESCRIPTION];
911 48 100       124 $text .= " $description\n" if $description;
912 48         68 my @comment = ();
913 48 50       125 $grammar_c->rule_length($rule_id) == 0
914             and push @comment, 'empty';
915 48 50       105 $thick_grammar->rule_is_used($rule_id)
916             or push @comment, '!used';
917 48 50       134 $grammar_c->rule_is_productive($rule_id)
918             or push @comment, 'unproductive';
919 48 50       111 $grammar_c->rule_is_accessible($rule_id)
920             or push @comment, 'inaccessible';
921 48 50       91 $rule->[Marpa::R2::Internal::Rule::DISCARD_SEPARATION]
922             and push @comment, 'discard_sep';
923              
924 48 50       88 if (@comment) {
925 0         0 $text .= q{ } . ( join q{ }, q{/*}, @comment, q{*/} ) . "\n";
926             }
927              
928             $text .= " Symbol IDs: <$lhs_id> ::= "
929 48         98 . ( join q{ }, map {"<$_>"} @rhs_ids ) . "\n";
  72         201  
930              
931             } ## end if ( $verbose >= 2 )
932              
933 183 100       418 if ( $verbose >= 3 ) {
934              
935 48         100 my $tracer = $thick_grammar->tracer();
936              
937             $text
938             .= " Internal symbols: <"
939             . $tracer->symbol_name($lhs_id)
940             . q{> ::= }
941             . (
942             join q{ },
943 48         98 map { '<' . $tracer->symbol_name($_) . '>' } @rhs_ids
  72         138  
944             ) . "\n";
945              
946             } ## end if ( $verbose >= 3 )
947              
948             } ## end for my $rule ( @{$rules} )
949              
950 10         86 return $text;
951             } ## end sub Marpa::R2::Scanless::G::show_rules
952              
953             sub Marpa::R2::Scanless::G::show_symbols {
954 4     4   869 my ( $slg, $verbose, $subgrammar ) = @_;
955 4         9 my $text = q{};
956 4   100     25 $verbose //= 0;
957 4   100     23 $subgrammar //= 'G1';
958              
959 4         20 my $thick_grammar = thick_subgrammar_by_name($slg, $subgrammar);
960              
961 4         22 my $symbols = $thick_grammar->[Marpa::R2::Internal::Grammar::SYMBOLS];
962 4         9 my $grammar_c = $thick_grammar->[Marpa::R2::Internal::Grammar::C];
963              
964 4         9 for my $symbol ( @{$symbols} ) {
  4         12  
965 68         106 my $symbol_id = $symbol->[Marpa::R2::Internal::Symbol::ID];
966              
967 68         156 $text .= join q{ }, $subgrammar, "S$symbol_id",
968             $thick_grammar->symbol_in_display_form($symbol_id);
969              
970 68         125 my $description = $symbol->[Marpa::R2::Internal::Symbol::DESCRIPTION];
971 68 100       124 if ($description) {
972 49         86 $text .= " -- $description";
973             }
974 68         96 $text .= "\n";
975              
976 68 100       118 if ( $verbose >= 2 ) {
977              
978 59         73 my @tag_list = ();
979 59 50       152 $grammar_c->symbol_is_productive($symbol_id)
980             or push @tag_list, 'unproductive';
981 59 50       132 $grammar_c->symbol_is_accessible($symbol_id)
982             or push @tag_list, 'inaccessible';
983 59 50       122 $grammar_c->symbol_is_nulling($symbol_id)
984             and push @tag_list, 'nulling';
985 59 100       138 $grammar_c->symbol_is_terminal($symbol_id)
986             and push @tag_list, 'terminal';
987              
988 59 100       103 if (@tag_list) {
989 30         68 $text
990             .= q{ } . ( join q{ }, q{/*}, @tag_list, q{*/} ) . "\n";
991             }
992              
993 59         115 my $tracer = $thick_grammar->tracer();
994 59         113 $text .= " Internal name: <"
995             . $tracer->symbol_name($symbol_id) . qq{>\n};
996              
997             } ## end if ( $verbose >= 2 )
998              
999 68 100       136 if ( $verbose >= 3 ) {
1000              
1001 59         96 my $dsl_form = $symbol->[Marpa::R2::Internal::Symbol::DSL_FORM];
1002 59 100       105 if ($dsl_form) { $text .= qq{ SLIF name: $dsl_form\n}; }
  42         99  
1003              
1004             } ## end if ( $verbose >= 3 )
1005              
1006             } ## end for my $symbol ( @{$symbols} )
1007              
1008 4         28 return $text;
1009             } ## end sub Marpa::R2::Scanless::G::show_symbols
1010              
1011             sub Marpa::R2::Scanless::G::show_dotted_rule {
1012 428     428   4294 my ( $slg, $rule_id, $dot_position ) = @_;
1013 428         625 my $grammar = $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1014 428         886 my $tracer = $grammar->tracer();
1015 428         619 my $grammar_c = $grammar->[Marpa::R2::Internal::Grammar::C];
1016             my ( $lhs, @rhs ) =
1017 428         920 map { $grammar->symbol_in_display_form($_) } $tracer->rule_expand($rule_id);
  2870         5389  
1018 428         855 my $rhs_length = scalar @rhs;
1019              
1020 428         915 my $minimum = $grammar_c->sequence_min($rule_id);
1021 428         644 my @quantifier = ();
1022 428 100       828 if (defined $minimum) {
1023 4 50       16 @quantifier = ($minimum <= 0 ? q{*} : q{+} );
1024             }
1025 428 100       813 $dot_position += ($rhs_length + 1) if $dot_position < 0;
1026 428 50       678 $dot_position = 0 if $dot_position < 0;
1027 428 100       721 if ($dot_position < $rhs_length) {
1028 324         673 splice @rhs, $dot_position, 0, q{.};
1029 324         1824 return join q{ }, $lhs, q{->}, @rhs, @quantifier;
1030             } else {
1031 104         468 return join q{ }, $lhs, q{->}, @rhs, @quantifier, q{.};
1032             }
1033             } ## end sub Marpa::R2::Grammar::show_dotted_rule
1034              
1035             sub Marpa::R2::Scanless::G::rule {
1036 6     6   61 my ( $slg, @args ) = @_;
1037 6         15 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR]
1038             ->rule(@args);
1039             }
1040              
1041             sub Marpa::R2::Scanless::G::rule_ids {
1042 11     11   5196 my ($slg, $subgrammar) = @_;
1043 11         42 return thick_subgrammar_by_name($slg, $subgrammar)->rule_ids();
1044             }
1045              
1046             sub Marpa::R2::Scanless::G::symbol_ids {
1047 6     6   4345 my ($slg, $subgrammar) = @_;
1048 6         20 return thick_subgrammar_by_name($slg, $subgrammar)->symbol_ids();
1049             }
1050              
1051             sub Marpa::R2::Scanless::G::g1_rule_ids {
1052 1     1   1317 my ($slg) = @_;
1053 1         4 return $slg->rule_ids();
1054             }
1055              
1056             sub Marpa::R2::Scanless::G::g0_rule_ids {
1057 1     1   19 my ($slg) = @_;
1058 1         5 return $slg->rule_ids('L0');
1059             }
1060              
1061             sub Marpa::R2::Scanless::G::g0_rule {
1062 17     17   162 my ( $slg, @args ) = @_;
1063 17         41 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_LEX_GRAMMARS]->[0]
1064             ->rule(@args);
1065             }
1066              
1067             # Internal methods, not to be documented
1068              
1069             sub Marpa::R2::Scanless::G::thick_g1_grammar {
1070 0     0   0 my ($slg) = @_;
1071 0         0 return $slg->[Marpa::R2::Internal::Scanless::G::THICK_G1_GRAMMAR];
1072             }
1073              
1074             sub Marpa::R2::Scanless::G::show_irls {
1075 2     2   8 my ($slg, $subgrammar) = @_;
1076 2         8 return thick_subgrammar_by_name($slg, $subgrammar)->show_irls();
1077             }
1078              
1079             sub Marpa::R2::Scanless::G::show_isys {
1080 2     2   1415 my ($slg, $subgrammar) = @_;
1081 2         9 return thick_subgrammar_by_name($slg, $subgrammar)->show_isys();
1082             }
1083              
1084             1;
1085              
1086             # vim: expandtab shiftwidth=4: