File Coverage

blib/lib/Marpa/R3/ASF2.pm
Criterion Covered Total %
statement 827 1004 82.3
branch 167 252 66.2
condition 19 38 50.0
subroutine 75 98 76.5
pod 0 31 0.0
total 1088 1423 76.4


line stmt bran cond sub pod time code
1             # Marpa::R3 is Copyright (C) 2018, Jeffrey Kegler.
2             #
3             # This module is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl 5.10.1. For more details, see the full text
5             # of the licenses in the directory LICENSES.
6             #
7             # This program is distributed in the hope that it will be
8             # useful, but it is provided "as is" and without any express
9             # or implied warranties. For details, see the full text of
10             # of the licenses in the directory LICENSES.
11              
12             package Marpa::R3::ASF2;
13              
14 104     104   1944 use 5.010001;
  104         403  
15 104     104   624 use strict;
  104         261  
  104         2223  
16 104     104   535 use warnings;
  104         217  
  104         2881  
17 104     104   563 no warnings qw(recursion);
  104         225  
  104         3507  
18              
19 104     104   603 use vars qw($VERSION $STRING_VERSION);
  104         299  
  104         9014  
20             $VERSION = '4.001_053';
21             $STRING_VERSION = $VERSION;
22             ## no critic(BuiltinFunctions::ProhibitStringyEval)
23             $VERSION = eval $VERSION;
24             ## use critic
25              
26             # The code in this file, for now, breaks "the rules". It makes use
27             # of internal methods not documented as part of Libmarpa.
28             # It is intended to create documented Libmarpa methods to underlie
29             # this interface, and rewrite it to use them
30              
31             package Marpa::R3::Internal_ASF2;
32              
33 104     104   902 use Scalar::Util qw(blessed tainted);
  104         327  
  104         6125  
34 104     104   673 use English qw( -no_match_vars );
  104         290  
  104         1070  
35              
36             our $PACKAGE = 'Marpa::R3::ASF2';
37              
38             # Set those common args which are at the Perl level.
39             # This is more complicated that it needs to be for the current implementation.
40             # It allows for LHS terminals (implemented in Libmarpa but not allowed by the SLIF).
41             # It also assumes that every or-node which can be constructed from preceding or-nodes
42             # and the input will be present. This is currently the case, but in the future
43             # rules and/or symbols may have extra-syntactic conditions attached making this
44             # assumption false.
45              
46             # Terms:
47              
48             # NID (Node ID): Encoded ID of either an or-node or an and-node.
49             #
50             # Extensions:
51             # Set "powers": A set of power 0 is an "atom" -- a single NID.
52             # A set of power 1 is a set of NID's -- a nidset.
53             # A set of power 2 is a set of sets of NID's, also called a powerset.
54             # A set of power 3 is a set of powersets, etc.
55             #
56             # The whole ID of NID is the external rule id of an or-node, or -1
57             # if the NID is for a token and-node.
58             #
59             # Intensions:
60             # A Symch is a nidset, where all the NID's share the same "whole ID"
61             # and the same span. NID's in a symch may differ in their internal rule,
62             # or have different causes. If the symch contains and-node NID's they
63             # will all have the same symbol.
64             #
65             # A choicepoint is a powerset -- a set of symches all of which share
66             # the same set of predecessors. (This set of predecessors is a power 3 set of
67             # choicepoints.) All symches in a choicepoint also share the same span,
68             # and the same symch-symbol. A symch's symbol is the LHS of the rule,
69             # or the symbol of the token in the token and-nodes.
70              
71             sub intset_id {
72 13532     13532   23401 my ( $asf, @ids ) = @_;
73 13532         29696 my $key = join q{ }, sort { $a <=> $b } @ids;
  116         488  
74 13532         19910 my $intset_by_key = $asf->[Marpa::R3::Internal_ASF2::INTSET_BY_KEY];
75 13532         20870 my $intset_id = $intset_by_key->{$key};
76 13532 100       30700 return $intset_id if defined $intset_id;
77 1756         2868 $intset_id = $asf->[Marpa::R3::Internal_ASF2::NEXT_INTSET_ID]++;
78 1756         4185 $intset_by_key->{$key} = $intset_id;
79 1756         3275 return $intset_id;
80             } ## end sub intset_id
81              
82             sub Marpa::R3::Nidset::obtain {
83 12642     12642   24452 my ( $class, $asf, @nids ) = @_;
84 12642         22755 my $id = intset_id( $asf, @nids );
85 12642         19561 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
86 12642         17482 my $nidset = $nidset_by_id->[$id];
87 12642 100       25214 return $nidset if defined $nidset;
88 1028         2064 $nidset = bless [], $class;
89 1028         1960 $nidset->[Marpa::R3::Internal::Nidset::ID] = $id;
90             $nidset->[Marpa::R3::Internal::Nidset::NIDS] =
91 1028         2247 [ sort { $a <=> $b } @nids ];
  60         203  
92 1028         1969 $nidset_by_id->[$id] = $nidset;
93 1028         1895 return $nidset;
94             } ## end sub Marpa::R3::Nidset::obtain
95              
96             sub Marpa::R3::Nidset::nids {
97 890     890   1377 my ($nidset) = @_;
98 890         2197 return $nidset->[Marpa::R3::Internal::Nidset::NIDS];
99             }
100              
101             sub Marpa::R3::Nidset::nid {
102 3532     3532   5631 my ( $nidset, $ix ) = @_;
103 3532         6748 return $nidset->[Marpa::R3::Internal::Nidset::NIDS]->[$ix];
104             }
105              
106             sub Marpa::R3::Nidset::count {
107 311     311   500 my ($nidset) = @_;
108 311         431 return scalar @{ $nidset->[Marpa::R3::Internal::Nidset::NIDS] };
  311         547  
109             }
110              
111             sub Marpa::R3::Nidset::id {
112 12642     12642   20368 my ($nidset) = @_;
113 12642         19274 return $nidset->[Marpa::R3::Internal::Nidset::ID];
114             }
115              
116             sub Marpa::R3::Nidset::show {
117 0     0   0 my ($nidset) = @_;
118 0         0 my $id = $nidset->id();
119 0         0 my $nids = $nidset->nids();
120 0         0 return "Nidset #$id: " . join q{ }, @{$nids};
  0         0  
121             } ## end sub Marpa::R3::Nidset::show
122              
123             sub Marpa::R3::Powerset::obtain {
124 890     890   1665 my ( $class, $asf, @nidset_ids ) = @_;
125 890         1571 my $id = intset_id( $asf, @nidset_ids );
126 890         1400 my $powerset_by_id = $asf->[Marpa::R3::Internal_ASF2::POWERSET_BY_ID];
127 890         1382 my $powerset = $powerset_by_id->[$id];
128 890 50       1628 return $powerset if defined $powerset;
129 890         1622 $powerset = bless [], $class;
130 890         1819 $powerset->[Marpa::R3::Internal::Powerset::ID] = $id;
131             $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS] =
132 890         2056 [ sort { $a <=> $b } @nidset_ids ];
  21         53  
133 890         1606 $powerset_by_id->[$id] = $powerset;
134 890         2113 return $powerset;
135             } ## end sub Marpa::R3::Powerset::obtain
136              
137             sub Marpa::R3::Powerset::nidset_ids {
138 0     0   0 my ($powerset) = @_;
139 0         0 return $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS];
140             }
141              
142             sub Marpa::R3::Powerset::count {
143 890     890   1435 my ($powerset) = @_;
144 890         1164 return scalar @{ $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS] };
  890         1724  
145             }
146              
147             sub Marpa::R3::Powerset::nidset_id {
148 0     0   0 my ( $powerset, $ix ) = @_;
149 0         0 my $nidset_ids = $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS];
150 0 0       0 return if $ix > $#{$nidset_ids};
  0         0  
151 0         0 return $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS]->[$ix];
152             } ## end sub Marpa::R3::Powerset::nidset_id
153              
154             sub Marpa::R3::Powerset::nidset {
155 1220     1220   2061 my ( $powerset, $asf, $ix ) = @_;
156 1220         1775 my $nidset_ids = $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS];
157 1220 50       1569 return if $ix > $#{$nidset_ids};
  1220         2532  
158 1220         1985 my $nidset_id = $powerset->[Marpa::R3::Internal::Powerset::NIDSET_IDS]->[$ix];
159 1220         1849 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
160 1220         2016 return $nidset_by_id->[$nidset_id];
161             } ## end sub Marpa::R3::Powerset::nidset_id
162              
163             sub Marpa::R3::Powerset::id {
164 0     0   0 my ($powerset) = @_;
165 0         0 return $powerset->[Marpa::R3::Internal::Powerset::ID];
166             }
167              
168             sub Marpa::R3::Powerset::show {
169 0     0   0 my ($powerset) = @_;
170 0         0 my $id = $powerset->id();
171 0         0 my $nidset_ids = $powerset->nidset_ids();
172 0         0 return "Powerset #$id: " . join q{ }, @{$nidset_ids};
  0         0  
173             } ## end sub Marpa::R3::Powerset::show
174              
175             sub set_last_choice {
176 26473     26473   37911 my ( $asf, $nook ) = @_;
177 26473         35817 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
178 26473         36421 my $or_node_id = $nook->[Marpa::R3::Internal::Nook::OR_NODE];
179 26473         34867 my $and_nodes = $or_nodes->[$or_node_id];
180 26473         32878 my $choice = $nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE];
181 26473 100       32262 return if $choice > $#{$and_nodes};
  26473         64752  
182 13776 100       23644 if ( nook_has_semantic_cause( $asf, $nook ) ) {
183 11072         17974 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
184 11072         15311 my $slg = $slr->[Marpa::R3::Internal_R::SLG];
185 11072         16079 my $and_node_id = $and_nodes->[$choice];
186 11072         23911 my ($current_predecessor) = $asf->call_by_tag(
187             ('@' . __FILE__ . ':' . __LINE__),
188             <<'END_OF_LUA',
189             local asf, id = ...
190             local current = asf.lmw_b:_and_node_predecessor(id)
191             return current and current or -1
192             END_OF_LUA
193             'i', $and_node_id);
194 11072         15691 AND_NODE: while (1) {
195 11135         14595 $choice++;
196 11135         16803 $and_node_id = $and_nodes->[$choice];
197 11135 100       21468 last AND_NODE if not defined $and_node_id;
198 70   50     338 my ($next_predecessor) = $asf->call_by_tag(
199             ('@' . __FILE__ . ':' . __LINE__),
200             <<'END_OF_LUA',
201             local asf, id = ...
202             local next = asf.lmw_b:_and_node_predecessor(id)
203             return next and next or -1
204             END_OF_LUA
205             'i', ($and_node_id // -1));
206 70 100       245 last AND_NODE if $current_predecessor != $next_predecessor;
207             } ## end AND_NODE: while (1)
208 11072         15968 $choice--;
209             } ## end if ( nook_has_semantic_cause( $asf, $nook ) )
210 13776         20722 $nook->[Marpa::R3::Internal::Nook::LAST_CHOICE] = $choice;
211 13776         20115 return $choice;
212             } ## end sub set_last_choice
213              
214             sub nook_new {
215 12697     12697   22636 my ( $asf, $or_node_id, $parent_or_node_id ) = @_;
216 12697         19492 my $nook = [];
217 12697         23692 $nook->[Marpa::R3::Internal::Nook::OR_NODE] = $or_node_id;
218 12697   100     24441 $nook->[Marpa::R3::Internal::Nook::PARENT] = $parent_or_node_id // -1;
219 12697         17492 $nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE] = 0;
220 12697         24722 set_last_choice( $asf, $nook );
221 12697         18405 return $nook;
222             } ## end sub nook_new
223              
224             sub nook_increment {
225 13776     13776   19747 my ( $asf, $nook ) = @_;
226 13776   50     22482 $nook->[Marpa::R3::Internal::Nook::LAST_CHOICE] //= 0;
227 13776         18284 $nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE] =
228             $nook->[Marpa::R3::Internal::Nook::LAST_CHOICE] + 1;
229 13776 100       21062 return if not defined set_last_choice( $asf, $nook );
230 1079         2420 return 1;
231             } ## end sub nook_increment
232              
233             sub nook_has_semantic_cause {
234 46535     46535   67207 my ( $asf, $nook ) = @_;
235 46535         66588 my $or_node = $nook->[Marpa::R3::Internal::Nook::OR_NODE];
236              
237 46535         99321 my ($result) = $asf->call_by_tag(
238             ('@' . __FILE__ . ':' . __LINE__),
239             <<'END_OF_LUA', 'i', $or_node);
240             local asf, or_node = ...
241             local slr = asf.slr
242             local irl_id = asf.lmw_b:_or_node_nrl(or_node)
243             local predot_position = asf.lmw_b:_or_node_position(or_node) - 1
244             local predot_isyid = slr.slg.g1:_nrl_rhs(irl_id, predot_position)
245             return slr.slg.g1:_nsy_is_semantic(predot_isyid)
246             END_OF_LUA
247 46535         104001 return $result;
248             } ## end sub nook_has_semantic_cause
249              
250             # No check for conflicting usage -- value(), asf(), etc.
251             # at this point
252             sub Marpa::R3::ASF2::peak {
253 61     61 0 171 my ($asf) = @_;
254 61         142 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
255              
256 61         194 my ($augment_or_node_id) = $asf->call_by_tag(
257             ('@' . __FILE__ . ':' . __LINE__),
258             <<'END_OF_LUA', '');
259             local asf = ...
260             local bocage = asf.lmw_b
261             if not bocage then error('No Bocage') end
262             return bocage:_top_or_node()
263             END_OF_LUA
264              
265             # TODO: This logic is from previous Libmarpa which added its own
266             # augment rule -- commented out, just in case.
267             # my $augment_and_node_id = $or_nodes->[$augment_or_node_id]->[0];
268             # my ($start_or_node_id)
269             # = $asf->call_by_tag(
270             # ('@' . __FILE__ . ':' . __LINE__),
271             # 'local asf, id = ...; return asf.lmw_b:_and_node_cause(id)',
272             # 'i',
273             # $augment_and_node_id
274             # );
275              
276 61         329 my $base_nidset = Marpa::R3::Nidset->obtain( $asf, $augment_or_node_id );
277 61         362 my $glade_id = $base_nidset->id();
278              
279             # Cannot "obtain" the glade if it is not registered
280 61         441 $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id]
281             ->[Marpa::R3::Internal::Glade::REGISTERED] = 1;
282 61         235 glade_obtain( $asf, $glade_id );
283 61         146 return $glade_id;
284             } ## end sub Marpa::R3::ASF2::peak
285              
286             our $NID_LEAF_BASE = -43;
287              
288             # Range from -1 to -42 reserved for special values
289 5523     5523   16762 sub and_node_to_nid { return -$_[0] + $NID_LEAF_BASE; }
290 1444     1444   2536 sub nid_to_and_node { return -$_[0] + $NID_LEAF_BASE; }
291              
292             # Set those common args which are at the Perl level.
293             sub asf_common_set {
294 58     58   141 my ( $asf, $flat_args ) = @_;
295 58 50       199 if ( my $value = $flat_args->{'trace_file_handle'} ) {
296 0         0 $asf->[Marpa::R3::Internal_ASF2::TRACE_FILE_HANDLE] = $value;
297             }
298 58         208 my $trace_file_handle =
299             $asf->[Marpa::R3::Internal_ASF2::TRACE_FILE_HANDLE];
300 58         123 delete $flat_args->{'trace_file_handle'};
301 58         132 return $flat_args;
302             }
303              
304             # Returns undef if no parse
305             sub Marpa::R3::ASF2::new {
306 58     58 0 2896 my ( $class, @args ) = @_;
307 58         195 my $asf = bless [], $class;
308              
309 58         121 my $end_of_parse;
310              
311 58         249 my ( $flat_args, $error_message ) = Marpa::R3::flatten_hash_args( \@args );
312 58 50       251 Marpa::R3::exception( sprintf $error_message, '$asf->new' )
313             if not $flat_args;
314 58         191 $flat_args = asf_common_set( $asf, $flat_args );
315              
316 58         141 my $slr = $flat_args->{recognizer};
317 58 50       175 Marpa::R3::exception(
318             qq{Marpa::R3::ASF2::new() called without a "recognizer" argument} )
319             if not defined $slr;
320 58         133 $asf->[Marpa::R3::Internal_ASF2::SLR] = $slr;
321 58         130 delete $flat_args->{recognizer};
322              
323 58         107 my $slr_class = 'Marpa::R3::Recognizer';
324 58 50 33     614 if ( not blessed $slr or not $slr->isa($slr_class) ) {
325 0         0 my $ref_type = ref $slr;
326 0 0       0 my $desc = $ref_type ? "a ref to $ref_type" : 'not a ref';
327 0         0 Marpa::R3::exception(
328             qq{'recognizer' named argument to new() is $desc\n},
329             " It should be a ref to $slr_class\n"
330             );
331             }
332              
333 58   33     355 $asf->[Marpa::R3::Internal_ASF2::TRACE_FILE_HANDLE] //=
334             $slr->[Marpa::R3::Internal_R::TRACE_FILE_HANDLE];
335              
336 58         124 my $trace_file_handle =
337             $asf->[Marpa::R3::Internal_ASF2::TRACE_FILE_HANDLE];
338              
339 58         113 my $lua = $slr->[Marpa::R3::Internal_R::L];
340 58         111 $asf->[Marpa::R3::Internal_ASF2::L] = $lua;
341              
342 58         301 ARG: for my $arg ( keys %{$flat_args} ) {
  58         209  
343 63 100       181 if ( $arg eq 'factoring_max' ) {
344             $asf->[Marpa::R3::Internal_ASF2::FACTORING_MAX] =
345 25         56 $flat_args->{$arg};
346 25         46 delete $flat_args->{$arg};
347 25         59 next ARG;
348             }
349             }
350              
351             my ( $regix ) = $slr->coro_by_tag(
352             ( '@' . __FILE__ . ':' . __LINE__ ),
353             {
354             signature => 's',
355             args => [$flat_args],
356             handlers => {
357             trace => sub {
358 0     0   0 my ($msg) = @_;
359 0         0 say {$trace_file_handle} $msg;
  0         0  
360 0         0 return 'ok';
361             },
362             }
363             },
364 58         694 <<'END_OF_LUA');
365             local slr, flat_args = ...
366             _M.wrap(function ()
367             local asf = slr:asf2_new(flat_args)
368             if not asf then return 'ok', -1 end
369             local order = asf.lmw_o
370             if not order then
371             error( 'Parse failed' )
372             end
373             if order:is_null() == 1 then
374             error([[
375             An attempt was make to create an ASF for a null parse\n\a
376             \u{20} A null parse is a successful parse of a zero-length string\n\z
377             \u{20} ASF's are not defined for null parses\n\z
378             ]])
379             end
380             return 'ok', asf.regix
381             end)
382             END_OF_LUA
383              
384 58 50       483 return if $regix < 0;
385 58         153 $asf->[Marpa::R3::Internal_ASF2::REGIX] = $regix;
386              
387 58   100     283 $asf->[Marpa::R3::Internal_ASF2::FACTORING_MAX] //= 42;
388 58         143 $asf->[Marpa::R3::Internal_ASF2::NEXT_INTSET_ID] = 0;
389 58         153 $asf->[Marpa::R3::Internal_ASF2::INTSET_BY_KEY] = {};
390 58         138 $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID] = [];
391 58         143 $asf->[Marpa::R3::Internal_ASF2::POWERSET_BY_ID] = [];
392 58         120 $asf->[Marpa::R3::Internal_ASF2::GLADES] = [];
393              
394 58         131 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES] = [];
395 58         132 OR_NODE: for ( my $or_node_id = 0;; $or_node_id++ ) {
396              
397 1866         4226 my ($and_node_ids) = $asf->call_by_tag(
398             ('@' . __FILE__ . ':' . __LINE__),
399             <<'END_OF_LUA', 'i>*', $or_node_id );
400             -- assumes throw mode
401             local asf, or_node_id = ...
402             local and_node_ids = {}
403             local order = asf.lmw_o
404             local count = order:_or_node_and_node_count(or_node_id)
405             if not count then return and_node_ids end
406             for ix = 1, count do
407             and_node_ids[ix] =
408             order:_or_node_and_node_id_by_ix(or_node_id, ix-1);
409             end
410             return and_node_ids
411             END_OF_LUA
412              
413 1866 100       2628 last OR_NODE if not scalar @{$and_node_ids};
  1866         3356  
414              
415             # Originally I had intended to sort the and node IDs by
416             # MAJOR: and-node predecessor (or -1 if no predecessor) and
417             # MINOR: and_node ID
418             # Don't know why, and in fact I screwed up the implementation
419             # and left the and nodes unsorted,
420             # which is how they are in the current implementation.
421              
422 1808         3255 $or_nodes->[$or_node_id] = $and_node_ids;
423              
424             } ## end OR_NODE: for ( my $or_node_id = 0;; $or_node_id++ )
425              
426 58         293 return $asf;
427              
428             } ## end sub Marpa::R3::ASF2::new
429              
430             sub Marpa::R3::ASF2::DESTROY {
431             # say STDERR "In Marpa::R3::ASF2::DESTROY before test";
432 58     58   5023 my $asf = shift;
433 58         141 my $lua = $asf->[Marpa::R3::Internal_ASF2::L];
434              
435             # If we are destroying the Perl interpreter, then all the Marpa
436             # objects will be destroyed, including Marpa's Lua interpreter.
437             # We do not need to worry about cleaning up the
438             # recognizer is an orderly manner, because the Lua interpreter
439             # containing the recognizer will be destroyed.
440             # In fact, the Lua interpreter may already have been destroyed,
441             # so this test is necessary to avoid a warning message.
442 58 50       177 return if not $lua;
443             # say STDERR "In Marpa::R3::ASF2::DESTROY after test";
444              
445 58         121 my $regix = $asf->[Marpa::R3::Internal_ASF2::REGIX];
446 58         202 $asf->call_by_tag(
447             ('@' . __FILE__ . ':' . __LINE__),
448             <<'END_OF_LUA', '');
449             local asf = ...
450             local regix = asf.regix
451             _M.unregister(_M.registry, regix)
452             END_OF_LUA
453             }
454              
455             sub Marpa::R3::ASF2::glade_is_visited {
456 0     0 0 0 my ( $asf, $glade_id ) = @_;
457 0         0 my $glade = $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id];
458 0 0       0 return if not $glade;
459 0         0 return $glade->[Marpa::R3::Internal::Glade::VISITED];
460             } ## end sub Marpa::R3::ASF2::glade_is_visited
461              
462             sub Marpa::R3::ASF2::glade_visited_clear {
463 0     0 0 0 my ( $asf, $glade_id ) = @_;
464 0 0       0 my $glade_list =
465             defined $glade_id
466             ? [ $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id] ]
467             : $asf->[Marpa::R3::Internal_ASF2::GLADES];
468             $_->[Marpa::R3::Internal::Glade::VISITED] = undef
469 0         0 for grep {defined} @{$glade_list};
  0         0  
  0         0  
470 0         0 return;
471             } ## end sub Marpa::R3::ASF2::glade_visited_clear
472              
473             sub nid_sort_ix {
474 940     940   1742 my ( $asf, $nid ) = @_;
475 940         1494 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
476              
477 940 100       2284 if ( $nid >= 0 ) {
478 342         947 my ($result) = $asf->call_by_tag(
479             ('@' . __FILE__ . ':' . __LINE__),
480             <<'END_OF_LUA', 'i', $nid);
481             local asf, nid = ...
482             local slr = asf.slr
483             local irl_id = asf.lmw_b:_or_node_nrl(nid)
484             return slr.slg.g1:_source_irl(irl_id)
485             END_OF_LUA
486 342         780 return $result;
487             }
488              
489 598         1244 my $and_node_id = nid_to_and_node($nid);
490              
491 598         1882 my ($result) = $asf->call_by_tag(
492             ('@' . __FILE__ . ':' . __LINE__),
493             <<'END_OF_LUA', 'i', $and_node_id);
494             local asf, and_node_id = ...
495             local slr = asf.slr
496             local token_nsy_id = asf.lmw_b:_and_node_symbol(and_node_id)
497             local token_id = slr.slg.g1:_source_isy(token_nsy_id)
498             -- -2 is reserved for 'end of data'
499             return -token_id - 3
500             END_OF_LUA
501 598         1219 return $result;
502             } ## end sub nid_sort_ix
503              
504             sub Marpa::R3::ASF2::grammar {
505 270     270 0 653 my ($asf) = @_;
506 270         431 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
507 270         408 my $slg = $slr->[Marpa::R3::Internal_R::SLG];
508 270         458 return $slg;
509             } ## end sub Marpa::R3::ASF2::grammar
510              
511             # TODO -- Document this method
512             sub Marpa::R3::ASF2::recognizer {
513 4     4 0 13 my ($asf) = @_;
514 4         6 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
515 4         7 return $slr;
516             }
517              
518             sub nid_rule_id {
519 909     909   1529 my ( $asf, $nid ) = @_;
520 909 100       3442 return if $nid < 0;
521              
522 311         869 my ($irl_id) = $asf->call_by_tag(
523             ('@' . __FILE__ . ':' . __LINE__),
524             <<'END_OF_LUA', 'i', $nid);
525             local asf, nid = ...
526             local slr = asf.slr
527             local irl_id = asf.lmw_b:_or_node_nrl(nid)
528             local irl_id = slr.slg.g1:_source_irl(irl_id)
529             return irl_id
530             END_OF_LUA
531 311         859 return $irl_id;
532             }
533              
534             sub or_node_es_span {
535 1831     1831   3062 my ( $asf, $choicepoint ) = @_;
536              
537 1831         4573 my ($origin_es, $current_es) = $asf->call_by_tag(
538             ('@' . __FILE__ . ':' . __LINE__),
539             <<'END_OF_LUA', 'i', $choicepoint);
540             local asf, choicepoint = ...
541             local slr = asf.slr
542             local origin_es = asf.lmw_b:_or_node_origin(choicepoint)
543             local current_es = asf.lmw_b:_or_node_set(choicepoint)
544             return origin_es, current_es
545             END_OF_LUA
546              
547 1831         5781 return $origin_es, $current_es - $origin_es;
548             } ## end sub or_node_es_span
549              
550             sub token_es_span {
551 716     716   1202 my ( $asf, $and_node_id ) = @_;
552              
553 716         1842 my ($predecessor_id, $parent_or_node_id) = $asf->call_by_tag(
554             ('@' . __FILE__ . ':' . __LINE__),
555             <<'END_OF_LUA',
556             local asf, and_node_id = ...
557             local slr = asf.slr
558             local b = asf.lmw_b
559             return
560             b:_and_node_predecessor(and_node_id),
561             b:_and_node_parent(and_node_id)
562             END_OF_LUA
563             'i', $and_node_id);
564              
565 716 100       1775 if ( defined $predecessor_id ) {
566              
567 253         722 my ($origin_es, $current_es) = $asf->call_by_tag(
568             ('@' . __FILE__ . ':' . __LINE__),
569             <<'END_OF_LUA',
570             local asf, predecessor_id, parent_or_node_id = ...
571             local slr = asf.slr
572             local b = asf.lmw_b
573             return
574             b:_or_node_set(predecessor_id),
575             b:_or_node_set(parent_or_node_id)
576             END_OF_LUA
577             'ii', $predecessor_id, $parent_or_node_id);
578              
579 253         688 return ( $origin_es, $current_es - $origin_es );
580             }
581              
582 463         898 return or_node_es_span( $asf, $parent_or_node_id );
583             } ## end sub token_es_span
584              
585             sub nid_literal {
586 1814     1814   3164 my ( $asf, $nid ) = @_;
587 1814         2724 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
588 1814 100       3926 if ( $nid <= $NID_LEAF_BASE ) {
589 614         1074 my $and_node_id = nid_to_and_node($nid);
590 614         1167 my ( $start, $length ) = token_es_span( $asf, $and_node_id );
591 614 100       2247 return q{} if $length == 0;
592 194         694 return $slr->g1_literal( $start, $length );
593             } ## end if ( $nid <= $NID_LEAF_BASE )
594 1200 50       2453 if ( $nid >= 0 ) {
595 1200         2300 return $slr->g1_literal( or_node_es_span( $asf, $nid ) );
596             }
597 0         0 Marpa::R3::exception("No literal for node ID: $nid");
598             }
599              
600             sub nid_span {
601 270     270   464 my ( $asf, $nid ) = @_;
602 270         381 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
603 270 100       652 if ( $nid <= $NID_LEAF_BASE ) {
604 102         181 my $and_node_id = nid_to_and_node($nid);
605 102         191 my ( $start, $length ) = token_es_span( $asf, $and_node_id );
606 102 50       325 return ($start, 0) if $length == 0;
607 0         0 return $start, $length;
608             } ## end if ( $nid <= $NID_LEAF_BASE )
609 168 50       320 if ( $nid >= 0 ) {
610 168         316 return or_node_es_span( $asf, $nid );
611             }
612 0         0 Marpa::R3::exception("No literal for node ID: $nid");
613             }
614              
615             sub nid_token_id {
616 197     197   346 my ( $asf, $nid ) = @_;
617 197 100       545 return if $nid > $NID_LEAF_BASE;
618 130         297 my $and_node_id = nid_to_and_node($nid);
619              
620 130         400 my ($token_id) = $asf->call_by_tag(
621             ('@' . __FILE__ . ':' . __LINE__),
622             <<'END_OF_LUA',
623             local asf, and_node_id = ...
624             local slr = asf.slr
625             local token_nsy_id = asf.lmw_b:_and_node_symbol(and_node_id)
626             local token_id = slr.slg.g1:_source_isy(token_nsy_id)
627             return token_id
628             END_OF_LUA
629             'i', $and_node_id);
630              
631 130         277 return $token_id;
632             }
633              
634             sub nid_symbol_id {
635 197     197   398 my ( $asf, $nid ) = @_;
636 197         433 my $token_id = nid_token_id($asf, $nid);
637 197 100       586 return $token_id if defined $token_id;
638 67 50       186 Marpa::R3::exception("No symbol ID for node ID: $nid") if $nid < 0;
639              
640             # Not a token, so return the LHS of the rule
641 67         211 my ($lhs_id) = $asf->call_by_tag(
642             ('@' . __FILE__ . ':' . __LINE__),
643             <<'END_OF_LUA',
644             local asf, nid = ...
645             local slr = asf.slr
646             local irl_id = asf.lmw_b:_or_node_nrl(nid)
647             local g1g = slr.slg.g1
648             local irl_id = g1g:_source_irl(irl_id)
649             local lhs_id = g1g:rule_lhs(irl_id)
650             return lhs_id
651             END_OF_LUA
652             'i', $nid);
653              
654 67         247 return $lhs_id;
655             }
656              
657             sub nid_symbol_name {
658 0     0   0 my ( $asf, $nid ) = @_;
659 0         0 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
660 0         0 my $slg = $slr->[Marpa::R3::Internal_R::SLG];
661 0         0 my $symbol_id = nid_symbol_id($asf, $nid);
662 0         0 return $slg->g1_symbol_name($symbol_id);
663             }
664              
665             sub nid_token_name {
666 0     0   0 my ( $asf, $nid ) = @_;
667 0         0 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
668 0         0 my $slg = $slr->[Marpa::R3::Internal_R::SLG];
669 0         0 my $token_id = nid_token_id($asf, $nid);
670 0 0       0 return if not defined $token_id;
671 0         0 return $slg->g1_symbol_name($token_id);
672             }
673              
674             # Memoization is heavily used -- it needs to be to keep the worst cases from
675             # going exponential. The need to memoize is the reason for the very heavy use of
676             # hashes. For example, quite often an HOH (hash of hashes) is used where
677             # an HoL (hash of lists) would usually be preferred. But the HOL would leave me
678             # with the problem of having duplicates, which if followed up upon, would make
679             # the algorithm go exponential.
680              
681             # For the "seen" hashes, the intent, in C, is to use a bit vector. Since typically
682             # choicepoints will only use a tiny fraction of the or- and and-node space, I'll create
683             # a per-choicepoint index in the bit vector for each or- and and-node. The index will
684             # per-ASF, and to avoid the overhead of clearing it, it will track, or each node, the
685             # current CP indexing it. It is assumed that the indexes need only remain valid within
686             # the method call that constructs the CPI (choicepoint iterator).
687              
688             sub first_factoring {
689 342     342   608 my ($choicepoint, $nid_of_choicepoint) = @_;
690              
691             # Current NID of current SYMCH
692             # The caller should ensure that we are never called unless the current
693             # NID is for a rule.
694 342 50       720 Marpa::R3::exception(
695             "Internal error: first_factoring() called for negative NID: $nid_of_choicepoint"
696             ) if $nid_of_choicepoint < 0;
697              
698             # Due to skipping, even the top or-node can have no valid choices
699 342         546 my $asf = $choicepoint->[Marpa::R3::Internal::Choicepoint::ASF];
700 342         560 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
701 342 50       447 if ( not scalar @{ $or_nodes->[$nid_of_choicepoint] } ) {
  342         785  
702 0         0 $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK] =
703             undef;
704 0         0 return;
705             }
706              
707             $choicepoint->[Marpa::R3::Internal::Choicepoint::OR_NODE_IN_USE]
708 342         909 ->{$nid_of_choicepoint} = 1;
709 342         774 my $nook = nook_new( $asf, $nid_of_choicepoint );
710 342         736 $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK] =
711             [$nook];
712              
713             # Iterate as long as we cannot finish this stack
714 342         849 while ( not factoring_finish($choicepoint, $nid_of_choicepoint) ) {
715 0 0       0 return if not factoring_iterate($choicepoint);
716             }
717 342         619 return 1;
718              
719             }
720              
721             sub next_factoring {
722 1421     1421   2594 my ($choicepoint, $nid_of_choicepoint) = @_;
723 1421         2270 my $factoring_stack =
724             $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK];
725 1421 50       2840 Marpa::R3::exception(
726             'Attempt to iterate factoring of uninitialized checkpoint')
727             if not $factoring_stack;
728              
729 1421         3057 while ( factoring_iterate($choicepoint) ) {
730 1079 50       2276 return 1 if factoring_finish($choicepoint, $nid_of_choicepoint);
731             }
732              
733             # Found nothing to iterate
734 342         651 return;
735             }
736              
737             sub factoring_iterate {
738 1421     1421   2217 my ($choicepoint) = @_;
739 1421         2028 my $asf = $choicepoint->[Marpa::R3::Internal::Choicepoint::ASF];
740 1421         2067 my $factoring_stack =
741             $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK];
742 1421         1824 FIND_NODE_TO_ITERATE: while (1) {
743 14118 100       16913 if ( not scalar @{$factoring_stack} ) {
  14118         23805  
744 342         518 $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK]
745             = undef;
746 342         906 return;
747             }
748 13776         18600 my $top_nook = $factoring_stack->[-1];
749 13776 100       21109 if ( nook_increment( $asf, $top_nook ) ) {
750 1079         2167 last FIND_NODE_TO_ITERATE; # in C, a "break" will do this
751             }
752              
753             # Could not iterate
754             # "Dirty" the corresponding bits in the parent and pop this nook
755 12697         16584 my $stack_ix_of_parent_nook =
756             $top_nook->[Marpa::R3::Internal::Nook::PARENT];
757 12697 100       19963 if ( $stack_ix_of_parent_nook >= 0 ) {
758 12355         15785 my $parent_nook = $factoring_stack->[$stack_ix_of_parent_nook];
759 12355 100       21132 $parent_nook->[Marpa::R3::Internal::Nook::CAUSE_IS_EXPANDED] = 0
760             if $top_nook->[Marpa::R3::Internal::Nook::IS_CAUSE];
761 12355 100       21972 $parent_nook->[Marpa::R3::Internal::Nook::PREDECESSOR_IS_EXPANDED]
762             = 0
763             if $top_nook->[Marpa::R3::Internal::Nook::IS_PREDECESSOR];
764             } ## end if ( $stack_ix_of_parent_nook >= 0 )
765              
766 12697         17077 my $top_or_node = $top_nook->[Marpa::R3::Internal::Nook::OR_NODE];
767             $choicepoint->[Marpa::R3::Internal::Choicepoint::OR_NODE_IN_USE]
768 12697         19990 ->{$top_or_node} = undef;
769 12697         14875 pop @{$factoring_stack};
  12697         22325  
770             } ## end FIND_NODE_TO_ITERATE: while (1)
771 1079         2362 return 1;
772             } ## end sub factoring_iterate
773              
774             sub factoring_finish {
775 1421     1421   2434 my ($choicepoint, $nid_of_choicepoint) = @_;
776 1421         2345 my $asf = $choicepoint->[Marpa::R3::Internal::Choicepoint::ASF];
777 1421         2118 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
778 1421         2055 my $factoring_stack =
779             $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK];
780              
781 1421         1942 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
782              
783 1421         2065 my @worklist = ( 0 .. $#{$factoring_stack} );
  1421         2980  
784              
785 1421         3134 DO_WORKLIST: while ( scalar @worklist ) {
786 31345         44074 my $stack_ix_of_work_nook = $worklist[-1];
787 31345         40913 my $work_nook = $factoring_stack->[$stack_ix_of_work_nook];
788 31345         43877 my $work_or_node = $work_nook->[Marpa::R3::Internal::Nook::OR_NODE];
789 31345         37678 my $working_choice =
790             $work_nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE];
791 31345         44427 my $work_and_node_id = $or_nodes->[$work_or_node]->[$working_choice];
792 31345         59834 my $child_or_node;
793             my $child_is_cause;
794 31345         0 my $child_is_predecessor;
795             FIND_CHILD_OR_NODE: {
796              
797 31345 100       39019 if ( !$work_nook->[Marpa::R3::Internal::Nook::CAUSE_IS_EXPANDED] )
  31345         55475  
798             {
799 13769 100       23732 if ( not nook_has_semantic_cause( $asf, $work_nook ) ) {
800 2704         6440 ($child_or_node) = $asf->call_by_tag(
801             ('@' . __FILE__ . ':' . __LINE__),
802             'local asf, work_and_node_id = ...; return asf.lmw_b:_and_node_cause(work_and_node_id)',
803             'i',
804             $work_and_node_id);
805 2704         4312 $child_is_cause = 1;
806 2704         4273 last FIND_CHILD_OR_NODE;
807             } ## end if ( not nook_has_semantic_cause( $asf, $work_nook ))
808             } ## end if ( !$work_nook->[...])
809 28641         45128 $work_nook->[Marpa::R3::Internal::Nook::CAUSE_IS_EXPANDED] = 1;
810 28641 100       48620 if ( !$work_nook
811             ->[Marpa::R3::Internal::Nook::PREDECESSOR_IS_EXPANDED] )
812             {
813 18980         43612 ($child_or_node) = $asf->call_by_tag(
814             ('@' . __FILE__ . ':' . __LINE__),
815             'local asf, work_and_node_id = ...; return asf.lmw_b:_and_node_predecessor(work_and_node_id)',
816             'i',
817             $work_and_node_id);
818 18980 100       37041 if ( defined $child_or_node ) {
819 9651         15141 $child_is_predecessor = 1;
820 9651         14990 last FIND_CHILD_OR_NODE;
821             }
822             } ## end if ( !$work_nook->[...])
823 18990         27625 $work_nook->[Marpa::R3::Internal::Nook::PREDECESSOR_IS_EXPANDED] =
824             1;
825 18990         24321 pop @worklist;
826 18990         40639 next DO_WORKLIST;
827             } ## end FIND_CHILD_OR_NODE:
828              
829             return 0
830             if
831             $choicepoint->[Marpa::R3::Internal::Choicepoint::OR_NODE_IN_USE]
832 12355 50       31146 ->{$child_or_node};
833              
834             return 0
835 12355 50       15243 if not scalar @{ $or_nodes->[$work_or_node] };
  12355         24963  
836              
837 12355         23402 my $new_nook =
838             nook_new( $asf, $child_or_node, $stack_ix_of_work_nook );
839 12355 100       22243 if ($child_is_cause) {
840 2704         5041 $new_nook->[Marpa::R3::Internal::Nook::IS_CAUSE] = 1;
841 2704         4629 $work_nook->[Marpa::R3::Internal::Nook::CAUSE_IS_EXPANDED] = 1;
842             }
843 12355 100       21384 if ($child_is_predecessor) {
844 9651         18671 $new_nook->[Marpa::R3::Internal::Nook::IS_PREDECESSOR] = 1;
845 9651         13881 $work_nook->[Marpa::R3::Internal::Nook::PREDECESSOR_IS_EXPANDED] =
846             1;
847             }
848 12355         16273 push @{$factoring_stack}, $new_nook;
  12355         18490  
849 12355         17958 push @worklist, $#{$factoring_stack};
  12355         28831  
850              
851             } ## end DO_WORKLIST: while ( scalar @worklist )
852              
853 1421         4114 return 1;
854              
855             } ## end sub factoring_finish
856              
857             sub and_nodes_to_cause_nids {
858 11074     11074   18565 my ( $asf, @and_node_ids ) = @_;
859 11074         15483 my %causes = ();
860 11074         17466 for my $and_node_id (@and_node_ids) {
861 11137         24803 my ($cause_nid) = $asf->call_by_tag(
862             ('@' . __FILE__ . ':' . __LINE__),
863             'local asf, and_node_id = ...; return asf.lmw_b:_and_node_cause(and_node_id)',
864             'i',
865             $and_node_id);
866 11137   66     26649 $cause_nid //= and_node_to_nid($and_node_id);
867 11137         26210 $causes{$cause_nid} = 1;
868             }
869 11074         34591 return [ keys %causes ];
870             } ## end sub and_nodes_to_cause_nids
871              
872             sub glade_id_factors {
873 1763     1763   2959 my ($choicepoint) = @_;
874 1763         2578 my $asf = $choicepoint->[Marpa::R3::Internal::Choicepoint::ASF];
875 1763         2558 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
876 1763         2654 my $slg = $slr->[Marpa::R3::Internal_R::SLG];
877 1763         2375 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
878              
879 1763         2195 my @result;
880 1763         2498 my $factoring_stack =
881             $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK];
882 1763 100       4391 return if not $factoring_stack;
883             FACTOR:
884 1421         2359 for (
885             my $factor_ix = 0;
886 20411         40560 $factor_ix <= $#{$factoring_stack};
887             $factor_ix++
888             )
889             {
890 18990         27962 my $nook = $factoring_stack->[$factor_ix];
891 18990 100       29928 next FACTOR if not nook_has_semantic_cause( $asf, $nook );
892 11074         18370 my $or_node = $nook->[Marpa::R3::Internal::Nook::OR_NODE];
893 11074         15422 my $and_nodes = $or_nodes->[$or_node];
894             my $cause_nids = and_nodes_to_cause_nids(
895             $asf,
896 11074         22602 map { $and_nodes->[$_] } (
  11137         24850  
897             $nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE]
898             .. $nook->[Marpa::R3::Internal::Nook::LAST_CHOICE]
899             )
900             );
901 11074         17551 my $base_nidset = Marpa::R3::Nidset->obtain( $asf, @{$cause_nids} );
  11074         23449  
902 11074         21696 my $glade_id = $base_nidset->id();
903              
904 11074         19965 $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id]
905             ->[Marpa::R3::Internal::Glade::REGISTERED] = 1;
906 11074         26414 push @result, $glade_id;
907             } ## end FACTOR: for ( my $factor_ix = 0; $factor_ix <= $#{...})
908 1421         4591 return \@result;
909             } ## end sub glade_id_factors
910              
911             sub glade_obtain {
912 4072     4072   6638 my ( $asf, $glade_id ) = @_;
913              
914 4072         5885 my $factoring_max = $asf->[Marpa::R3::Internal_ASF2::FACTORING_MAX];
915              
916 4072         5780 my $glades = $asf->[Marpa::R3::Internal_ASF2::GLADES];
917 4072         5842 my $glade = $glades->[$glade_id];
918 4072 50 33     13632 if ( not defined $glade
919             or not $glade->[Marpa::R3::Internal::Glade::REGISTERED] )
920             {
921 0         0 say Data::Dumper::Dumper($glade);
922 0         0 Marpa::R3::exception(
923             "Attempt to use an invalid glade, one whose ID is $glade_id");
924             } ## end if ( not defined $glade or not $glade->[...])
925              
926             # Return the glade if it is already set up
927 4072 100       9349 return $glade if $glade->[Marpa::R3::Internal::Glade::SYMCHES];
928              
929 890         1415 my $base_nidset =
930             $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID]->[$glade_id];
931 890         1318 my $choicepoint;
932             my $choicepoint_powerset;
933             {
934 890         1166 my @source_data = ();
  890         1220  
935 890         1099 for my $source_nid ( @{ $base_nidset->nids() } ) {
  890         1853  
936 940         1794 my $sort_ix = nid_sort_ix( $asf, $source_nid );
937 940         2696 push @source_data, [ $sort_ix, $source_nid ];
938             }
939 890         2130 my @sorted_source_data = sort { $a->[0] <=> $b->[0] } @source_data;
  52         229  
940 890         1279 my $nid_ix = 0;
941             my ( $sort_ix_of_this_nid, $this_nid ) =
942 890         1136 @{ $sorted_source_data[ $nid_ix++ ] };
  890         1866  
943 890         1282 my @nids_with_current_sort_ix = ();
944 890         1110 my $current_sort_ix = $sort_ix_of_this_nid;
945 890         1220 my @symch_ids = ();
946 890         1183 NID: while (1) {
947              
948 1830 100       3295 if ( $sort_ix_of_this_nid != $current_sort_ix ) {
949              
950             # Currently only whole id break logic
951 909         2122 my $nidset_for_sort_ix = Marpa::R3::Nidset->obtain( $asf,
952             @nids_with_current_sort_ix );
953 909         2074 push @symch_ids, $nidset_for_sort_ix->id();
954 909         1529 @nids_with_current_sort_ix = ();
955 909         1493 $current_sort_ix = $sort_ix_of_this_nid;
956             } ## end if ( $sort_ix_of_this_nid != $current_sort_ix )
957 1830 100       3600 last NID if not defined $this_nid;
958 940         1707 push @nids_with_current_sort_ix, $this_nid;
959 940         1389 my $sorted_entry = $sorted_source_data[ $nid_ix++ ];
960 940 100       1792 if ( defined $sorted_entry ) {
961 50         107 ( $sort_ix_of_this_nid, $this_nid ) = @{$sorted_entry};
  50         112  
962 50         113 next NID;
963             }
964 890         1474 $this_nid = undef;
965 890         1291 $sort_ix_of_this_nid = -2;
966             } ## end NID: while (1)
967 890         2008 $choicepoint_powerset = Marpa::R3::Powerset->obtain( $asf, @symch_ids );
968 890         1795 $choicepoint->[Marpa::R3::Internal::Choicepoint::ASF] = $asf;
969 890         2077 $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK] =
970             undef;
971             }
972              
973             # Check if choicepoint already seen?
974 890         1328 my @symches = ();
975 890         1779 my $symch_count = $choicepoint_powerset->count();
976 890         2223 SYMCH: for ( my $symch_ix = 0; $symch_ix < $symch_count; $symch_ix++ ) {
977 909         1483 $choicepoint->[Marpa::R3::Internal::Choicepoint::FACTORING_STACK] =
978             undef;
979 909         1742 my $symch_nidset = $choicepoint_powerset->nidset($asf, $symch_ix);
980 909         2017 my $choicepoint_nid = $symch_nidset->nid(0);
981 909   100     1806 my $g1_symch_rule_id = nid_rule_id($asf, $choicepoint_nid) // -1;
982              
983             # Initial undef indicates no factorings omitted
984 909         1895 my @factorings = ( $g1_symch_rule_id, undef );
985              
986             # For a token
987             # There will not be multiple factorings or nids,
988             # it is assumed, for a token
989 909 100       1785 if ( $g1_symch_rule_id < 0 ) {
990 598         1357 my $base_nidset = Marpa::R3::Nidset->obtain( $asf, $choicepoint_nid );
991 598         1145 my $glade_id = $base_nidset->id();
992              
993 598         1097 $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id]
994             ->[Marpa::R3::Internal::Glade::REGISTERED] = 1;
995 598         1453 push @factorings, [$glade_id];
996 598         1188 push @symches, \@factorings;
997 598         1765 next SYMCH;
998             } ## end if ( $g1_symch_rule_id < 0 )
999              
1000 311         707 my $symch = $choicepoint_powerset->nidset($asf, $symch_ix);
1001 311         675 my $nid_count = $symch->count();
1002             FACTORINGS_LOOP:
1003 311         761 for ( my $nid_ix = 0; $nid_ix < $nid_count; $nid_ix++ ) {
1004 342         707 $choicepoint_nid = $symch_nidset->nid($nid_ix);
1005 342         933 first_factoring($choicepoint, $choicepoint_nid);
1006 342         696 my $factoring = glade_id_factors($choicepoint);
1007              
1008 342         774 FACTOR: while ( defined $factoring ) {
1009 1421 50       3096 if ( scalar @factorings > $factoring_max ) {
1010              
1011             # update factorings omitted flag
1012 0         0 $factorings[1] = 1;
1013 0         0 last FACTORINGS_LOOP;
1014             }
1015 1421         2709 my @factoring = ();
1016 1421         1926 for (
1017 1421         3418 my $item_ix = $#{$factoring};
1018             $item_ix >= 0;
1019             $item_ix--
1020             )
1021             {
1022 11074         20732 push @factoring, $factoring->[$item_ix];
1023             } ## end for ( my $item_ix = $#{$factoring}; $item_ix >= 0; ...)
1024 1421         4632 push @factorings, \@factoring;
1025 1421         3587 next_factoring($choicepoint, $choicepoint_nid);
1026 1421         2906 $factoring = glade_id_factors($choicepoint);
1027             } ## end FACTOR: while ( defined $factoring )
1028             } ## end FACTORINGS_LOOP: for ( my $nid_ix = 0; $nid_ix < $nid_count; $nid_ix...)
1029 311         1033 push @symches, \@factorings;
1030             } ## end SYMCH: for ( my $symch_ix = 0; $symch_ix < $symch_count; ...)
1031              
1032 890         1629 $glade->[Marpa::R3::Internal::Glade::SYMCHES] = \@symches;
1033              
1034 890         1449 $glade->[Marpa::R3::Internal::Glade::ID] = $glade_id;
1035 890         1358 $asf->[Marpa::R3::Internal_ASF2::GLADES]->[$glade_id] = $glade;
1036 890         2466 return $glade;
1037             } ## end sub glade_obtain
1038              
1039             sub Marpa::R3::ASF2::glade_symch_count {
1040 862     862 0 1528 my ( $asf, $glade_id ) = @_;
1041 862         1497 my $glade = glade_obtain( $asf, $glade_id );
1042 862 50       1747 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $glade;
1043 862         1119 return scalar @{ $glade->[Marpa::R3::Internal::Glade::SYMCHES] };
  862         1648  
1044             }
1045              
1046             sub Marpa::R3::ASF2::glade_literal {
1047 1814     1814 0 2804 my ( $asf, $glade_id ) = @_;
1048 1814         2637 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
1049 1814         2463 my $nidset = $nidset_by_id->[$glade_id];
1050 1814 50       3447 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $nidset;
1051 1814         3313 my $nid0 = $nidset->nid(0);
1052 1814         3769 return nid_literal($asf, $nid0);
1053             } ## end sub Marpa::R3::ASF2::glade_literal
1054              
1055             sub Marpa::R3::ASF2::glade_g1_span {
1056 270     270 0 478 my ( $asf, $glade_id ) = @_;
1057 270         430 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
1058 270         385 my $nidset = $nidset_by_id->[$glade_id];
1059 270 50       541 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $nidset;
1060 270         541 my $nid0 = $nidset->nid(0);
1061 270         646 my ($g1_start, $g1_length) = nid_span($asf, $nid0);
1062 270         576 return $g1_start, $g1_length;
1063             }
1064              
1065             sub Marpa::R3::ASF2::glade_L0_length {
1066 57     57 0 119 my ( $asf, $glade_id ) = @_;
1067 57         116 my ($g1_start, $g1_length) = $asf->glade_g1_span( $glade_id );
1068 57         120 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
1069              
1070 57         189 my ($l0_length) = $slr->call_by_tag(
1071             ('@' . __FILE__ . ':' . __LINE__),
1072             <<'END_OF_LUA', 'ii', $g1_start, $g1_length);
1073             local slr, g1_start, g1_length = ...
1074             return slr:g1_span_l0_length(g1_start, g1_length)
1075             END_OF_LUA
1076 57         135 return $l0_length;
1077             }
1078              
1079             sub Marpa::R3::ASF2::g1_glade_symbol_id {
1080 197     197 0 382 my ( $asf, $glade_id ) = @_;
1081 197         362 my $nidset_by_id = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
1082 197         317 my $nidset = $nidset_by_id->[$glade_id];
1083 197 50       454 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $nidset;
1084 197         487 my $nid0 = $nidset->nid(0);
1085 197         462 return nid_symbol_id($asf, $nid0);
1086             }
1087              
1088             sub Marpa::R3::ASF2::g1_symch_rule_id {
1089 204     204 0 573 my ( $asf, $glade_id, $symch_ix ) = @_;
1090 204         430 my $glade = glade_obtain( $asf, $glade_id );
1091 204         345 my $symches = $glade->[Marpa::R3::Internal::Glade::SYMCHES];
1092 204 50       308 return if $symch_ix > $#{$symches};
  204         440  
1093 204         308 my ($rule_id) = @{ $symches->[$symch_ix] };
  204         368  
1094 204         424 return $rule_id;
1095             }
1096              
1097             sub Marpa::R3::ASF2::symch_factoring_count {
1098 1843     1843 0 3212 my ( $asf, $glade_id, $symch_ix ) = @_;
1099 1843         3696 my $glade = glade_obtain( $asf, $glade_id );
1100 1843 50       3676 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $glade;
1101 1843         2669 my $symches = $glade->[Marpa::R3::Internal::Glade::SYMCHES];
1102 1843 50       2412 return if $symch_ix > $#{$symches};
  1843         4063  
1103 1843         2484 return $#{ $symches->[$symch_ix] } - 1; # length minus 2
  1843         3959  
1104             } ## end sub Marpa::R3::ASF2::symch_factoring_count
1105              
1106             sub Marpa::R3::ASF2::factoring_downglades {
1107 369     369 0 731 my ( $asf, $glade_id, $symch_ix, $factoring_ix ) = @_;
1108 369         686 my $glade = glade_obtain( $asf, $glade_id );
1109 369 50       725 Marpa::R3::exception("No glade found for glade ID $glade_id)") if not defined $glade;
1110 369         537 my $symches = $glade->[Marpa::R3::Internal::Glade::SYMCHES];
1111             Marpa::R3::exception("No symch #$symch_ix exists for glade ID $glade_id")
1112 369 50       532 if $symch_ix > $#{$symches};
  369         709  
1113 369         567 my $symch = $symches->[$symch_ix];
1114 369         463 my ( $rule_id, undef, @factorings ) = @{$symch};
  369         757  
1115 369 50       785 Marpa::R3::exception("No downglades for glade ID $glade_id, symch #$symch_ix: it is a token symch")
1116             if $rule_id < 0;
1117 369 50       698 return if $factoring_ix >= scalar @factorings;
1118 369         561 my $factoring = $factorings[$factoring_ix];
1119 369         795 return $factoring;
1120             }
1121              
1122             sub Marpa::R3::ASF2::factoring_symbol_count {
1123 97     97 0 190 my ( $asf, $glade_id, $symch_ix, $factoring_ix ) = @_;
1124 97         198 my $factoring = $asf->factoring_downglades($glade_id, $symch_ix, $factoring_ix);
1125 97 50       239 return if not defined $factoring;
1126 97         136 return scalar @{$factoring};
  97         164  
1127             } ## end sub Marpa::R3::ASF2::factoring_symbol_count
1128              
1129             sub Marpa::R3::ASF2::factor_downglade {
1130 168     168 0 330 my ( $asf, $glade_id, $symch_ix, $factoring_ix, $symbol_ix ) = @_;
1131 168         305 my $factoring = $asf->factoring_downglades($glade_id, $symch_ix, $factoring_ix);
1132 168 50       337 return if not defined $factoring;
1133 168         291 return $factoring->[$symbol_ix];
1134             } ## end sub Marpa::R3::ASF2::factor_downglade
1135              
1136             sub Marpa::R3::Internal_ASF2::ambiguities {
1137 15     15   114 my ($asf) = @_;
1138 15         116 my $peak = $asf->peak();
1139 15         79 return Marpa::R3::Internal_ASF2::glade_ambiguities( $asf, $peak, [] );
1140             }
1141              
1142             sub Marpa::R3::Internal_ASF2::glade_ambiguities {
1143 42     42   102 my ( $asf, $glade, $seen ) = @_;
1144 42 50       114 return [] if $seen->[$glade]; # empty on revisit
1145 42         80 $seen->[$glade] = 1;
1146 42         115 my $grammar = $asf->grammar();
1147 42         123 my $symch_count = $asf->glade_symch_count($glade);
1148 42 100       115 if ( $symch_count > 1 ) {
1149 5         25 my $literal = $asf->glade_literal($glade);
1150 5         27 my $symbol_id = $asf->g1_glade_symbol_id($glade);
1151 5         36 my $display_form = $grammar->g1_symbol_display_form($symbol_id);
1152 5         37 return [ [ 'symch', $glade, ] ];
1153             } ## end if ( $symch_count > 1 )
1154 37         117 my $g1_rule_id = $asf->g1_symch_rule_id( $glade, 0 );
1155 37 100       128 return [] if $g1_rule_id < 0; # no ambiguities if a token
1156              
1157             # ignore any truncation of the factorings
1158              
1159 32         99 my $factoring_count = $asf->symch_factoring_count( $glade, 0 );
1160 32 100       96 if ( $factoring_count <= 1 ) {
1161 22         72 my $downglades = $asf->factoring_downglades( $glade, 0, 0 );
1162             my @problems =
1163 22         48 map { @{ glade_ambiguities( $asf, $_, $seen ) } } @{$downglades};
  26         42  
  26         219  
  22         50  
1164 22         102 return \@problems;
1165             } ## end if ( $factoring_count <= 1 )
1166 10         38 my @results = ();
1167              
1168 10         39 my $downglades = $asf->factoring_downglades( $glade, 0, 0 );
1169 10         25 my $min_factors = $#{$downglades} + 1;
  10         28  
1170 10         42 my ( $upglade_start, $upglade_length ) = $asf->glade_g1_span($glade);
1171 10         28 my $sync_location = $upglade_start + $upglade_length;
1172              
1173 10         28 my @factors_by_factoring = ($downglades);
1174 10         47 for (
1175             my $factoring_ix = 1;
1176             $factoring_ix < $factoring_count;
1177             $factoring_ix++
1178             )
1179             {
1180 34         83 my $downglades =
1181             $asf->factoring_downglades( $glade, 0, $factoring_ix );
1182 34         48 my $factor_count = $#{$downglades} + 1;
  34         65  
1183 34 100       86 $min_factors =
1184             $min_factors > $factor_count ? $factor_count : $min_factors;
1185              
1186             # Determine a first potential
1187             # "sync location of the factors" from
1188             # the earliest start of the first downglade of any factoring.
1189             # Currently this will be the start of the parent glade, but this
1190             # method will be safe against any future hacks.
1191 34         87 my ($this_sync_location) = $asf->glade_g1_span( $downglades->[0] );
1192 34         101 $sync_location =
1193             List::Util::min( $this_sync_location, $sync_location );
1194              
1195 34         99 push @factors_by_factoring, $downglades;
1196             } ## end for ( my $factoring_ix = 1; $factoring_ix < $factoring_count...)
1197              
1198 10         49 my @factor_ix = (0) x $factoring_count;
1199 10         20 SYNC_PASS: while (1) {
1200              
1201             # Assume synced and unambiguous until we see otherwise.
1202 32         49 my $is_synced = 1;
1203              
1204             # First find a synch'ed set of factors, if we can
1205             FACTORING:
1206 32         86 for (
1207             my $factoring_ix = 0;
1208             $factoring_ix < $factoring_count;
1209             $factoring_ix++
1210             )
1211             {
1212 111         171 my $this_factor_ix = $factor_ix[$factoring_ix];
1213 111         160 my $this_downglade =
1214             $factors_by_factoring[$factoring_ix][$this_factor_ix];
1215 111         214 my ($this_start) = $asf->glade_g1_span($this_downglade);
1216              
1217             # To keep time complexity down we limit the number of times we deal
1218             # with a factoring at a sync location to 3, worst case -- a pass which
1219             # identifies it as a potential sync location, a pass which
1220             # (if possible) brings all the factors to that location, and a
1221             # pass which leaves all factor IX's where they are, and determines
1222             # we have found a sync location. This makes out time O(f*n), where
1223             # f is the factoring count and n is the mininum number of factors.
1224              
1225 111         236 while ( $this_start < $sync_location ) {
1226 31         59 $factor_ix[$factoring_ix]++;
1227 31 100       80 last SYNC_PASS if $factor_ix[$factoring_ix] >= $min_factors;
1228 21         42 $this_start = $asf->glade_g1_span($this_downglade);
1229             } ## end if ( $this_start < $sync_location )
1230 101 100       267 if ( $this_start > $sync_location ) {
1231 15         35 $is_synced = 0;
1232 15         38 $sync_location = $this_start;
1233             }
1234             } ## end FACTORING: for ( my $factoring_ix = 0; $factoring_ix < ...)
1235              
1236 22 100       70 next SYNC_PASS if not $is_synced;
1237              
1238             # If here, every factor starts at the sync location
1239              
1240             SYNCED_RESULT: {
1241              
1242 14         21 my $ambiguous_factors;
  14         24  
1243 14         25 my $first_factor_ix = $factor_ix[0];
1244 14         28 my $first_downglade = $factors_by_factoring[0][$first_factor_ix];
1245              
1246             FACTORING:
1247 14         45 for (
1248             my $factoring_ix = 1;
1249             $factoring_ix < $factoring_count;
1250             $factoring_ix++
1251             )
1252             {
1253 20         32 my $this_factor_ix = $factor_ix[$factoring_ix];
1254 20         35 my $this_downglade =
1255             $factors_by_factoring[$factoring_ix][$this_factor_ix];
1256 20 100       65 if ( $this_downglade != $first_downglade ) {
1257 13         36 $ambiguous_factors = [
1258             $first_factor_ix, $factoring_ix,
1259             $this_factor_ix
1260             ];
1261 13         33 last FACTORING;
1262             } ## end if ( $this_downglade != $first_downglade )
1263              
1264             } ## end FACTORING: for ( my $factoring_ix = 1; $factoring_ix < ...)
1265              
1266             # If here, all the the downglades are identical
1267 14 100       43 if ( not defined $ambiguous_factors ) {
1268             push @results,
1269 1         3 @{ glade_ambiguities( $asf, $first_downglade, $seen ) };
  1         10  
1270 1         3 last SYNCED_RESULT;
1271             }
1272              
1273             # First factoring IX is always zero
1274             push @results,
1275 13         26 [ 'factoring', $glade, 0, @{$ambiguous_factors} ];
  13         52  
1276             } ## end SYNCED_RESULT:
1277              
1278 14         142 $factor_ix[$_]++ for 0 .. $factoring_count;
1279 14 50       84 last SYNC_PASS if List::Util::max(@factor_ix) >= $min_factors;
1280              
1281             } ## end SYNC_PASS: while (1)
1282              
1283 10         106 return \@results;
1284              
1285             } ## end sub Marpa::R3::Internal_ASF2::glade_ambiguities
1286              
1287             # A generic display routine for ambiguities -- complex application will
1288             # want to replace this, using it perhaps as a fallback.
1289             sub Marpa::R3::Internal_ASF2::ambiguities_show {
1290 15     15   198 my ( $asf, $ambiguities ) = @_;
1291 15         55 my $grammar = $asf->grammar();
1292 15         50 my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
1293 15         38 my $result = q{};
1294 15         31 AMBIGUITY: for my $ambiguity ( @{$ambiguities} ) {
  15         48  
1295 18         43 my $type = $ambiguity->[0];
1296 18 100       67 if ( $type eq 'symch' ) {
1297              
1298 5         10 my ( undef, $glade ) = @{$ambiguity};
  5         14  
1299 5         17 my $symbol_display_form =
1300             $grammar->g1_symbol_display_form(
1301             $asf->g1_glade_symbol_id($glade) );
1302              
1303 5         32 my $l0_length = $asf->glade_L0_length($glade);
1304 5         18 my ( $g1_start, $g1_length ) = $asf->glade_g1_span($glade);
1305 5         38 my ( $l0_block1, $l0_pos1 ) = $slr->g1_to_block_first($g1_start);
1306 5         41 my ( $l0_block2, $l0_pos2 ) = $slr->g1_to_block_last($g1_start + $g1_length -1);
1307 5         28 my $l0_range = $slr->lc_brief($l0_block1, $l0_pos1, $l0_block2, $l0_pos2);
1308 5         29 my $display_length = List::Util::min( $l0_length, 60 );
1309 5         27 $result
1310             .= qq{Ambiguous symch at Glade=$glade, Symbol=<$symbol_display_form>:\n};
1311 5         16 $result
1312             .= qq{ The ambiguity is at $l0_range\n};
1313 5 50       22 my $literal_label =
1314             $display_length == $l0_length ? 'Text is: ' : 'Text begins: ';
1315              
1316 5         25 my ($escaped_input) = $slr->call_by_tag(
1317             ('@' . __FILE__ . ':' . __LINE__),
1318             <<'END_OF_LUA', 'ii', $g1_start, $display_length);
1319             local slr, g1_start, input_length = ...
1320             return slr:g1_escape(g1_start, input_length)
1321             END_OF_LUA
1322              
1323 5         25 $result
1324             .= q{ }
1325             . $literal_label
1326             . $escaped_input
1327             . qq{\n};
1328              
1329 5         27 my $symch_count = $asf->glade_symch_count($glade);
1330 5         25 my $display_symch_count = List::Util::min( 5, $symch_count );
1331 5 50       31 $result .=
1332             $symch_count == $display_symch_count
1333             ? " There are $symch_count symches\n"
1334             : " There are $symch_count symches -- showing only the first $display_symch_count\n";
1335 5         24 SYMCH_IX: for my $symch_ix ( 0 .. $display_symch_count - 1 ) {
1336 10         32 my $g1_rule_id = $asf->g1_symch_rule_id( $glade, $symch_ix );
1337 10 50       32 if ( $g1_rule_id < 0 ) {
1338 0         0 $result .= " Symch $symch_ix is a token\n";
1339 0         0 next SYMCH_IX;
1340             }
1341 10         50 $result .= " Symch $symch_ix is a rule: "
1342             . $grammar->g1_rule_show($g1_rule_id) . "\n";
1343             } ## end SYMCH_IX: for my $symch_ix ( 0 .. $display_symch_count - 1 )
1344              
1345 5         21 next AMBIGUITY;
1346             } ## end if ( $type eq 'symch' )
1347 13 50       44 if ( $type eq 'factoring' ) {
1348 13         28 my $factoring_ix1 = 0;
1349             my ( undef, $glade, $symch_ix, $factor_ix1, $factoring_ix2,
1350             $factor_ix2 )
1351 13         23 = @{$ambiguity};
  13         56  
1352 13         45 my $first_downglades =
1353             $asf->factoring_downglades( $glade, $symch_ix, 0 );
1354 13         43 my $first_downglade = $first_downglades->[$factor_ix1];
1355             {
1356 13         26 my $these_downglades =
  13         39  
1357             $asf->factoring_downglades( $glade, $symch_ix,
1358             $factoring_ix2 );
1359 13         39 my $this_downglade = $these_downglades->[$factor_ix2];
1360 13         55 my $symbol_display_form =
1361             $grammar->g1_symbol_display_form(
1362             $asf->g1_glade_symbol_id($first_downglade) );
1363              
1364 13         44 my ( $g1_start, $g1_length ) =
1365             $asf->glade_g1_span($first_downglade);
1366 13 100       70 my $g1_last = $g1_length > 0 ? ($g1_start + $g1_length - 1) : $g1_start;
1367              
1368 13         71 my ( $l0_block1, $l0_pos1 ) = $slr->g1_to_block_first($g1_start);
1369 13         65 my ( $l0_block2, $l0_pos2 ) = $slr->g1_to_block_last($g1_last);
1370 13         58 my $l0_range = $slr->lc_brief($l0_block1, $l0_pos1, $l0_block2, $l0_pos2);
1371              
1372 13         52 my $first_length = $asf->glade_L0_length($first_downglade);
1373 13         39 my $this_length = $asf->glade_L0_length($this_downglade);
1374 13         54 my $display_length =
1375             List::Util::min( $first_length, $this_length, 60 );
1376 13         61 $result
1377             .= qq{Length of symbol "$symbol_display_form" at $l0_range is ambiguous\n};
1378              
1379 13 100       48 if ( $display_length > 0 ) {
1380              
1381 1         4 my ($piece) = $slr->call_by_tag(
1382             ('@' . __FILE__ . ':' . __LINE__),
1383             <<'END_OF_LUA', 'ii', $g1_start, $display_length);
1384             local slr, g1_start, input_length = ...
1385             local escaped_input = slr:g1_escape(g1_start, input_length)
1386             return " Choices start with: " .. escaped_input .. "\n"
1387             END_OF_LUA
1388              
1389 1         4 $result .= $piece;
1390              
1391             } ## end if ( $display_length > 0 )
1392              
1393 13         48 my @display_downglade = ( $first_downglade, $this_downglade );
1394             DISPLAY_GLADE:
1395 13         60 for (
1396             my $glade_ix = 0;
1397             $glade_ix <= $#display_downglade;
1398             $glade_ix++
1399             )
1400             {
1401             # Choices may be zero length
1402 26         56 my $choice_number = $glade_ix + 1;
1403 26         51 my $glade_id = $display_downglade[$glade_ix];
1404 26         65 my $l0_length = $asf->glade_L0_length($glade_id);
1405 26 100       83 if ( $l0_length <= 0 ) {
1406 12         50 $result
1407             .= qq{ Choice $choice_number is zero length\n};
1408 12         43 next DISPLAY_GLADE;
1409             }
1410              
1411 14         47 my ( $g1_start, $g1_length ) = $asf->glade_g1_span($glade_id);
1412 14         56 my ( $l0_block, $l0_pos ) = $slr->g1_to_block_last($g1_start + $g1_length -1);
1413 14         57 my $l0_location = $slr->lc_brief($l0_block, $l0_pos);
1414              
1415 14         81 $result
1416             .= qq{ Choice $choice_number, length=$l0_length, ends at $l0_location\n};
1417              
1418 14         59 my ($piece) = $slr->call_by_tag(
1419             ('@' . __FILE__ . ':' . __LINE__),
1420             <<'END_OF_LUA', 'iiii', $choice_number, $g1_start, $g1_length, $l0_length);
1421             local slr, choice_number, g1_start, g1_length, l0_length = ...
1422             local subpieces = {}
1423             local escaped_input
1424             if l0_length > 60 then
1425             escaped_input =
1426             slr:reversed_g1_escape(g1_start + g1_length, 60)
1427             subpieces[#subpieces+1] = string.format(" Choice %d ending: %s\n",
1428             choice_number,
1429             escaped_input)
1430             end
1431             local display_length = math.min(l0_length, 60)
1432             escaped_input = slr:g1_escape(g1_start, display_length)
1433             subpieces[#subpieces+1] = string.format(" Choice %d: %s\n",
1434             choice_number,
1435             escaped_input)
1436             return table.concat(subpieces)
1437             END_OF_LUA
1438              
1439 14         84 $result .= $piece;
1440              
1441             } ## end DISPLAY_GLADE: for ( my $glade_ix = 0; $glade_ix <= ...)
1442 13         57 next AMBIGUITY;
1443             } ## end FACTORING: for ( my $factoring_ix = 1; $factoring_ix < ...)
1444 0         0 next AMBIGUITY;
1445             } ## end if ( $type eq 'factoring' )
1446             $result
1447 0         0 .= qq{Ambiguities of type "$type" not implemented:\n}
1448             . Data::Dumper::dumper($ambiguity);
1449 0         0 next AMBIGUITY;
1450              
1451             } ## end AMBIGUITY: for my $ambiguity ( @{$ambiguities} )
1452 15         117 return $result;
1453             } ## end sub Marpa::R3::Internal_ASF2::ambiguities_show
1454              
1455             # The higher level calls
1456              
1457             sub Marpa::R3::ASF2::traverse {
1458 31     31 0 916 my ( $asf, $per_traverse_object, $method ) = @_;
1459 31 50       109 if ( ref $method ne 'CODE' ) {
1460 0         0 Marpa::R3::exception(
1461             'Argument to $asf->traverse() must be an anonymous subroutine');
1462             }
1463 31 50       88 if ( not ref $per_traverse_object ) {
1464 0         0 Marpa::R3::exception(
1465             'Argument to $asf->traverse() must be a reference');
1466             }
1467 31         95 my $peak = $asf->peak();
1468 31         70 my $peak_glade = glade_obtain( $asf, $peak );
1469 31         107 my $traverser = bless [], "Marpa::R3::Internal_ASF2::Traverse";
1470 31         92 $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF] = $asf;
1471 31         56 $traverser->[Marpa::R3::Internal_ASF2::Traverse::CODE] = $method;
1472 31         50 $traverser->[Marpa::R3::Internal_ASF2::Traverse::PER_TRAVERSE_OBJECT] = $per_traverse_object;
1473 31         59 $traverser->[Marpa::R3::Internal_ASF2::Traverse::VALUES] = [];
1474 31         65 $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE] = $peak_glade;
1475 31         100 $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX] = 0;
1476 31         57 $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX] = 0;
1477 31         106 return $method->( $traverser, $per_traverse_object );
1478             } ## end sub Marpa::R3::ASF2::traverse
1479              
1480             sub Marpa::R3::Internal_ASF2::Traverse::all_choices {
1481 12     12   92 my ( $traverser ) = @_;
1482              
1483 12         31 my @values = Marpa::R3::Internal_ASF2::Traverse::rh_values( $traverser );
1484 12         27 my @results = ( [] );
1485 12         32 for my $rh_ix ( 0 .. @values - 1 ) {
1486 24         34 my @new_results = ();
1487 24         35 for my $old_result (@results) {
1488 26         38 my $child_value = $values[$rh_ix];
1489 26 50       55 $child_value = [ $child_value ] unless ref $child_value eq 'ARRAY';
1490 26         33 for my $new_value ( @{ $child_value } ) {
  26         39  
1491 30         39 push @new_results, [ @{$old_result}, $new_value ];
  30         72  
1492             }
1493             }
1494 24         50 @results = @new_results;
1495             } ## end for my $rh_ix ( 0 .. $length - 1 )
1496              
1497 12         29 return @results;
1498             }
1499              
1500             # TODO -- Document this method
1501             sub Marpa::R3::Internal_ASF2::Traverse::asf {
1502 4     4   16 my ( $traverser ) = @_;
1503 4         10 return $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1504             }
1505              
1506             sub Marpa::R3::Internal_ASF2::Traverse::literal {
1507 1742     1742   7869 my ( $traverser ) = @_;
1508 1742         2593 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1509 1742         2386 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1510 1742         2479 my $glade_id = $glade->[Marpa::R3::Internal::Glade::ID];
1511 1742         3325 return $asf->glade_literal($glade_id);
1512             }
1513              
1514             # TODO document span() -> g1_span()
1515             sub Marpa::R3::Internal_ASF2::Traverse::g1_span {
1516 4     4   22 my ( $traverser ) = @_;
1517 4         8 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1518 4         7 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1519 4         6 my $glade_id = $glade->[Marpa::R3::Internal::Glade::ID];
1520 4         11 return $asf->glade_g1_span($glade_id);
1521             }
1522              
1523             sub Marpa::R3::Internal_ASF2::Traverse::symbol_id {
1524 103     103   307 my ( $traverser ) = @_;
1525 103         146 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1526 103         149 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1527 103         139 my $glade_id = $glade->[Marpa::R3::Internal::Glade::ID];
1528 103         244 return $asf->g1_glade_symbol_id($glade_id);
1529             }
1530              
1531             sub Marpa::R3::Internal_ASF2::Traverse::rule_id {
1532 1788     1788   9368 my ( $traverser ) = @_;
1533 1788         2544 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1534 1788         2375 my $symch_ix =
1535             $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX];
1536 1788         2492 my $symch = $glade->[Marpa::R3::Internal::Glade::SYMCHES]->[$symch_ix];
1537 1788         2256 my ( $rule_id ) = @{$symch};
  1788         2979  
1538 1788 100       4068 return if $rule_id < 0;
1539 1241         2136 return $rule_id;
1540             } ## end sub Marpa::R3::Internal_ASF2::Traverse::rule_id
1541              
1542             sub Marpa::R3::Internal_ASF2::Traverse::rh_length {
1543 1249     1249   4048 my ( $traverser ) = @_;
1544 1249         1922 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1545 1249         1724 my $symch_ix =
1546             $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX];
1547 1249         1718 my $symch = $glade->[Marpa::R3::Internal::Glade::SYMCHES]->[$symch_ix];
1548 1249         1639 my ( $rule_id, undef, @factorings ) = @{$symch};
  1249         9153  
1549 1249 50       2608 Marpa::R3::exception(
1550             '$glade->rh_length($rh_ix) called for a token -- that is not allowed')
1551             if $rule_id < 0;
1552 1249         1860 my $factoring_ix =
1553             $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX];
1554 1249         2014 my $factoring = $factorings[$factoring_ix];
1555 1249         1691 return scalar @{$factoring};
  1249         7191  
1556             } ## end sub Marpa::R3::Internal_ASF2::Traverse::rh_length
1557              
1558             sub Marpa::R3::Internal_ASF2::Traverse::rh_value {
1559 10708     10708   25774 my ( $traverser, $rh_ix ) = @_;
1560 10708         13975 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1561 10708         13068 my $symch_ix =
1562             $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX];
1563 10708         13858 my $symch = $glade->[Marpa::R3::Internal::Glade::SYMCHES]->[$symch_ix];
1564 10708         13224 my ( $rule_id, undef, @factorings ) = @{$symch};
  10708         57149  
1565 10708 50       19616 Marpa::R3::exception(
1566             '$glade->rh_value($rh_ix) called for a token -- that is not allowed')
1567             if $rule_id < 0;
1568 10708         14453 my $factoring_ix =
1569             $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX];
1570 10708         13764 my $factoring = $factorings[$factoring_ix];
1571 10708 50       12863 return if $rh_ix > $#{$factoring};
  10708         18209  
1572 10708         15360 my $downglade_id = $factoring->[$rh_ix];
1573 10708         14128 my $memoized_value = $traverser->[Marpa::R3::Internal_ASF2::Traverse::VALUES]->[$downglade_id];
1574 10708 100       57593 return $memoized_value if defined $memoized_value;
1575 702         973 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1576 702         1217 my $downglade = glade_obtain( $asf, $downglade_id );
1577 702         1390 my $blessing = ref $traverser;
1578              
1579             # A shallow clone
1580 702         932 my $child_traverser = bless [ @{$traverser} ], $blessing;
  702         1974  
1581 702         1082 $child_traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE] =
1582             $downglade;
1583 702         968 $child_traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX] = 0;
1584 702         922 $child_traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX] = 0;
1585 702         1016 my $code = $traverser->[Marpa::R3::Internal_ASF2::Traverse::CODE];
1586 702         2093 my $value = $code->(
1587             $child_traverser,
1588             $traverser->[Marpa::R3::Internal_ASF2::Traverse::PER_TRAVERSE_OBJECT]
1589             );
1590 702 50       3217 Marpa::R3::exception(
1591             'The ASF traversing method returned undef -- that is not allowed')
1592             if not defined $value;
1593 702         1653 $traverser->[Marpa::R3::Internal_ASF2::Traverse::VALUES]->[$downglade_id]
1594             = $value;
1595 702         4003 return $value;
1596             } ## end sub Marpa::R3::Internal_ASF2::Traverse::rh_value
1597              
1598             sub Marpa::R3::Internal_ASF2::Traverse::rh_values {
1599 17     17   45 my ( $traverser ) = @_;
1600 17         75 return map { Marpa::R3::Internal_ASF2::Traverse::rh_value( $traverser, $_ ) }
  35         93  
1601             0 .. Marpa::R3::Internal_ASF2::Traverse::rh_length( $traverser ) - 1;
1602             }
1603              
1604             sub Marpa::R3::Internal_ASF2::Traverse::next_factoring {
1605 1721     1721   2861 my ($traverser) = @_;
1606 1721         2655 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1607 1721         2703 my $glade_id = $glade->[Marpa::R3::Internal::Glade::ID];
1608 1721         2435 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1609 1721         2202 my $symch_ix = $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX];
1610 1721         3700 my $last_factoring =
1611             $asf->symch_factoring_count( $glade_id, $symch_ix ) - 1;
1612 1721         2464 my $factoring_ix =
1613             $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX];
1614 1721 100       4436 return if $factoring_ix >= $last_factoring;
1615 1056         1575 $factoring_ix++;
1616 1056         1438 $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX] =
1617             $factoring_ix;
1618 1056         2892 return $factoring_ix;
1619             } ## end sub Marpa::R3::Internal_ASF2::Traverse::next_factoring
1620              
1621             sub Marpa::R3::Internal_ASF2::Traverse::next_symch {
1622 665     665   1067 my ($traverser) = @_;
1623 665         907 my $glade = $traverser->[Marpa::R3::Internal_ASF2::Traverse::GLADE];
1624 665         906 my $glade_id = $glade->[Marpa::R3::Internal::Glade::ID];
1625 665         929 my $asf = $traverser->[Marpa::R3::Internal_ASF2::Traverse::ASF];
1626 665         923 my $symch_ix = $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX];
1627 665         1636 my $last_symch = $asf->glade_symch_count( $glade_id ) - 1;
1628 665 100       2352 return if $symch_ix >= $last_symch;
1629 7         14 $symch_ix++;
1630 7         15 $traverser->[Marpa::R3::Internal_ASF2::Traverse::SYMCH_IX] = $symch_ix;
1631 7         13 $traverser->[Marpa::R3::Internal_ASF2::Traverse::FACTORING_IX] = 0;
1632 7         22 return $symch_ix;
1633             } ## end sub Marpa::R3::Internal_ASF2::Traverse::next_symch
1634              
1635             sub Marpa::R3::Internal_ASF2::Traverse::next {
1636 1721     1721   3728 my ($traverser) = @_;
1637 1721   100     3226 return $traverser->next_factoring() // $traverser->next_symch();
1638             }
1639              
1640             # GLADE_SEEN is a local -- this is to silence warnings
1641             our %GLADE_SEEN;
1642              
1643             sub form_choice {
1644 40     40   84 my ( $parent_choice, $sub_choice ) = @_;
1645 40 100       109 return $sub_choice if not defined $parent_choice;
1646 12         37 return join q{.}, $parent_choice, $sub_choice;
1647             }
1648              
1649             sub Marpa::R3::ASF2::dump_glade {
1650 181     181 0 371 my ( $asf, $glade_id, $parent_choice, $item_ix ) = @_;
1651 181 100       428 if ( $GLADE_SEEN{$glade_id} ) {
1652 44         139 return [ [0, $glade_id, "already displayed"] ];
1653             }
1654 137         368 $GLADE_SEEN{$glade_id} = 1;
1655              
1656 137         286 my $grammar = $asf->grammar();
1657 137         250 my @lines = ();
1658 137         200 my $symch_indent = 0;
1659              
1660 137         302 my $symch_count = $asf->glade_symch_count($glade_id);
1661 137         224 my $symch_choice = $parent_choice;
1662 137 100       269 if ( $symch_count > 1 ) {
1663 4   50     12 $item_ix //= 0;
1664 4         23 push @lines,
1665             [ 0, undef, "Symbol #$item_ix "
1666             . $grammar->g1_symbol_display_form($asf->g1_glade_symbol_id($glade_id))
1667             . " has $symch_count symches" ];
1668 4         17 $symch_indent += 2;
1669 4         14 $symch_choice = form_choice( $parent_choice, $item_ix );
1670             } ## end if ( $symch_count > 1 )
1671 137         279 for ( my $symch_ix = 0; $symch_ix < $symch_count; $symch_ix++ ) {
1672 141 100       304 my $current_choice =
1673             $symch_count > 1
1674             ? form_choice( $symch_choice, $symch_ix )
1675             : $symch_choice;
1676 141         188 my $indent = $symch_indent;
1677 141 100       261 if ( $symch_count > 1 ) {
1678 8         36 push @lines, [ $symch_indent , undef, "Symch #$current_choice" ];
1679             }
1680 141         342 my $rule_id = $asf->g1_symch_rule_id( $glade_id, $symch_ix );
1681 141 100       288 if ( $rule_id >= 0 ) {
1682 78         348 push @lines,
1683             [
1684             $symch_indent, $glade_id,
1685             "Rule $rule_id: " . $grammar->g1_rule_show($rule_id)
1686             ];
1687 78         146 for my $line (
1688 78         245 @{ dump_factorings(
1689             $asf, $glade_id, $symch_ix, $current_choice
1690             ) }
1691             )
1692             {
1693 561         715 my ( $line_indent, @rest_of_line ) = @{$line};
  561         1035  
1694 561         1525 push @lines, [ $line_indent + $symch_indent + 2, @rest_of_line ];
1695             } ## end for my $line ( dump_factorings( $asf, $glade_id, ...))
1696             } ## end if ( $rule_id >= 0 )
1697             else {
1698 63         159 my $line = dump_terminal( $asf, $glade_id, $current_choice );
1699 63         105 my ( $line_indent, @rest_of_line ) = @{$line};
  63         148  
1700 63         302 push @lines, [ $line_indent + $symch_indent, @rest_of_line ];
1701             } ## end else [ if ( $rule_id >= 0 ) ]
1702             } ## end for ( my $symch_ix = 0; $symch_ix < $symch_count; $symch_ix...)
1703 137         347 return \@lines;
1704             }
1705              
1706             # Show all the factorings of a SYMCH
1707             sub dump_factorings {
1708 78     78   497 my ( $asf, $glade_id, $symch_ix, $parent_choice ) = @_;
1709              
1710 78         125 my @lines;
1711 78         176 my $factoring_count = $asf->symch_factoring_count( $glade_id, $symch_ix );
1712 78         192 for (
1713             my $factoring_ix = 0;
1714             $factoring_ix < $factoring_count;
1715             $factoring_ix++
1716             )
1717             {
1718 97         137 my $indent = 0;
1719 97         151 my $current_choice = $parent_choice;
1720 97 100       182 if ( $factoring_count > 1 ) {
1721 28         44 $indent = 2;
1722 28         60 $current_choice = form_choice( $parent_choice, $factoring_ix );
1723 28         88 push @lines, [ 0, undef, "Factoring #$current_choice" ];
1724             }
1725 97         217 my $symbol_count =
1726             $asf->factoring_symbol_count( $glade_id, $symch_ix,
1727             $factoring_ix );
1728 97         262 SYMBOL: for my $symbol_ix ( 0 .. $symbol_count - 1 ) {
1729 168         375 my $downglade =
1730             $asf->factor_downglade( $glade_id, $symch_ix, $factoring_ix,
1731             $symbol_ix );
1732 168         240 for my $line (
1733 168         408 @{ $asf->dump_glade( $downglade, $current_choice,
1734             $symbol_ix )
1735             }
1736             )
1737             {
1738 533         674 my ( $line_indent, @rest_of_line ) = @{$line};
  533         1014  
1739 533         1561 push @lines, [ $line_indent + $indent, @rest_of_line ];
1740              
1741             } ## end for my $line ( @{ $asf->dump_glade( $downglade, ...)})
1742             } ## end SYMBOL: for my $symbol_ix ( 0 .. $symbol_count - 1 )
1743             } ## end for ( my $factoring_ix = 0; $factoring_ix < $factoring_count...)
1744 78         176 return \@lines;
1745             } ## end sub dump_factorings
1746              
1747             sub dump_terminal {
1748 63     63   131 my ( $asf, $glade_id, $symch_ix, $parent_choice ) = @_;
1749              
1750             # There can only be one symbol in a terminal and therefore only one factoring
1751 63         94 my $current_choice = $parent_choice;
1752 63         124 my $literal = $asf->glade_literal($glade_id);
1753 63         202 my $symbol_id = $asf->g1_glade_symbol_id($glade_id);
1754 63         150 my $grammar = $asf->grammar();
1755 63         208 my $display_form = $grammar->g1_symbol_display_form($symbol_id);
1756 63         266 return [0, $glade_id, qq{Symbol $display_form: "$literal"}];
1757             } ## end sub dump_terminal
1758              
1759             sub Marpa::R3::ASF2::dump {
1760 13     13 0 99 my ($asf) = @_;
1761 13         43 my $peak = $asf->peak();
1762 13         35 local %GLADE_SEEN = (); ## no critic (Variables::ProhibitLocalVars)
1763 13         43 my $lines = $asf->dump_glade( $peak );
1764 13         23 my $next_sequenced_id = 1; # one-based
1765 13         25 my %sequenced_id = ();
1766 13   66     24 $sequenced_id{$_} //= $next_sequenced_id++ for grep { defined } map { $_->[1] } @{$lines};
  225         656  
  225         385  
  13         26  
1767 13         51 my $text = q{};
1768 13         40 for my $line ( @{$lines}[ 1 .. $#$lines ] ) {
  13         44  
1769 212         272 my ( $line_indent, $glade_id, $body ) = @{$line};
  212         347  
1770 212         290 $line_indent -= 2;
1771 212         308 $text .= q{ } x $line_indent;
1772 212 100       478 $text .= 'GL' . $sequenced_id{$glade_id} . q{ } if defined $glade_id;
1773 212         460 $text .= "$body\n";
1774             }
1775 13         167 return $text;
1776             } ## end sub show
1777              
1778             sub Marpa::R3::ASF2::show_nidsets {
1779 0     0 0 0 my ($asf) = @_;
1780 0         0 my $text = q{};
1781 0         0 my $nidsets = $asf->[Marpa::R3::Internal_ASF2::NIDSET_BY_ID];
1782 0         0 for my $nidset ( grep {defined} @{$nidsets} ) {
  0         0  
  0         0  
1783 0         0 $text .= $nidset->show() . "\n";
1784             }
1785 0         0 return $text;
1786             } ## end sub Marpa::R3::ASF2::show_nidsets
1787              
1788             sub Marpa::R3::ASF2::show_powersets {
1789 0     0 0 0 my ($asf) = @_;
1790 0         0 my $text = q{};
1791 0         0 my $powersets = $asf->[Marpa::R3::Internal_ASF2::POWERSET_BY_ID];
1792 0         0 for my $powerset ( grep {defined} @{$powersets} ) {
  0         0  
  0         0  
1793 0         0 $text .= $powerset->show() . "\n";
1794             }
1795 0         0 return $text;
1796             } ## end sub Marpa::R3::ASF2::show_powersets
1797              
1798             sub dump_nook {
1799 0     0   0 my ( $asf, $nook ) = @_;
1800 0         0 my $or_nodes = $asf->[Marpa::R3::Internal_ASF2::OR_NODES];
1801 0         0 my $or_node_id = $nook->[Marpa::R3::Internal::Nook::OR_NODE];
1802 0         0 my $and_node_count = scalar @{ $or_nodes->[$or_node_id] };
  0         0  
1803 0         0 my $text = 'Nook ';
1804 0         0 my @text = ();
1805 0 0       0 push @text, $nook->[Marpa::R3::Internal::Nook::IS_CAUSE] ? q{C} : q{-};
1806 0 0       0 push @text,
1807             $nook->[Marpa::R3::Internal::Nook::IS_PREDECESSOR] ? q{P} : q{-};
1808 0 0       0 push @text,
1809             $nook->[Marpa::R3::Internal::Nook::CAUSE_IS_EXPANDED] ? q{C+} : q{--};
1810 0 0       0 push @text,
1811             $nook->[Marpa::R3::Internal::Nook::PREDECESSOR_IS_EXPANDED]
1812             ? q{P+}
1813             : q{--};
1814 0         0 $text .= join q{ }, @text;
1815 0         0 $text
1816             .= ' @'
1817             . $nook->[Marpa::R3::Internal::Nook::FIRST_CHOICE] . q{-}
1818             . $nook->[Marpa::R3::Internal::Nook::LAST_CHOICE]
1819             . qq{ of $and_node_count: };
1820 0         0 $text .= $asf->verbose_or_node($or_node_id);
1821 0         0 return $text;
1822             } ## end sub dump_nook
1823              
1824             # For debugging
1825             sub dump_factoring_stack {
1826 0     0   0 my ( $asf, $stack ) = @_;
1827 0         0 my $text = q{};
1828 0         0 for ( my $stack_ix = 0; $stack_ix <= $#{$stack}; $stack_ix++ ) {
  0         0  
1829              
1830             # Nook already has newline at end
1831 0         0 $text .= "$stack_ix: " . dump_nook( $asf, $stack->[$stack_ix] );
1832             }
1833 0         0 return $text . "\n";
1834             } ## end sub dump_factoring_stack
1835              
1836             # not to be documented
1837             sub Marpa::R3::ASF2::call_by_tag {
1838 96731     96731 0 181669 my ( $asf, $tag, $codestr, $signature, @args ) = @_;
1839 96731         141613 my $lua = $asf->[Marpa::R3::Internal_ASF2::L];
1840 96731         125349 my $regix = $asf->[Marpa::R3::Internal_ASF2::REGIX];
1841              
1842 96731         179384 my @results;
1843             my $eval_error;
1844 96731         0 my $eval_ok;
1845             {
1846 96731         117623 local $@;
  96731         123111  
1847 96731         133916 $eval_ok = eval {
1848 96731         627087 @results =
1849             $lua->call_by_tag( $regix, $tag, $codestr, $signature, @args );
1850 96731         185434 return 1;
1851             };
1852 96731         175190 $eval_error = $@;
1853             }
1854 96731 50       175950 if ( not $eval_ok ) {
1855 0         0 Marpa::R3::exception($eval_error);
1856             }
1857 96731         188350 return @results;
1858             }
1859              
1860             # not to be documented
1861             sub Marpa::R3::ASF2::coro_by_tag {
1862 0     0 0   my ( $asf, $tag, $args, $codestr ) = @_;
1863 0           my $lua = $asf->[Marpa::R3::Internal_ASF2::L];
1864 0           my $regix = $asf->[Marpa::R3::Internal_ASF2::REGIX];
1865 0   0       my $handler = $args->{handlers} // {};
1866 0           my $resume_tag = $tag . '[R]';
1867 0   0       my $signature = $args->{signature} // '';
1868 0   0       my $p_args = $args->{args} // [];
1869              
1870 0           my @results;
1871             my $eval_error;
1872 0           my $eval_ok;
1873             {
1874 0           local $@;
  0            
1875 0           $eval_ok = eval {
1876 0           $lua->call_by_tag( $regix, $tag, $codestr, $signature, @{$p_args} );
  0            
1877 0           my @resume_args = ('');
1878 0           my $signature = 's';
1879 0           CORO_CALL: while (1) {
1880 0           my ( $cmd, $yield_data ) =
1881             $lua->call_by_tag( $regix, $resume_tag,
1882             'local asf, resume_arg = ...; return _M.resume(resume_arg)',
1883             $signature, @resume_args ) ;
1884 0 0         if (not $cmd) {
1885 0           @results = @{$yield_data};
  0            
1886 0           return 1;
1887             }
1888 0           my $handler = $handler->{$cmd};
1889 0 0         Marpa::R3::exception(qq{No coro handler for "$cmd"})
1890             if not $handler;
1891 0   0       $yield_data //= [];
1892 0           my ($handler_cmd, $new_resume_args) = $handler->(@{$yield_data});
  0            
1893 0 0         Marpa::R3::exception(qq{Undefined return command from handler for "$cmd"})
1894             if not defined $handler_cmd;
1895 0 0         if ($handler_cmd eq 'ok') {
1896 0           $signature = 's';
1897 0           @resume_args = ($new_resume_args);
1898 0 0         if (scalar @resume_args < 1) {
1899 0           @resume_args = ('');
1900             }
1901 0           next CORO_CALL;
1902             }
1903 0 0         if ($handler_cmd eq 'sig') {
1904 0           @resume_args = @{$new_resume_args};
  0            
1905 0           $signature = shift @resume_args;
1906 0           next CORO_CALL;
1907             }
1908 0           Marpa::R3::exception(qq{Bad return command ("$handler_cmd") from handler for "$cmd"})
1909             }
1910 0           return 1;
1911             };
1912 0           $eval_error = $@;
1913             }
1914 0 0         if ( not $eval_ok ) {
1915             # if it's an object, just die
1916 0 0         die $eval_error if ref $eval_error;
1917 0           Marpa::R3::exception($eval_error);
1918             }
1919 0           return @results;
1920             }
1921              
1922             # not to be documented
1923             sub Marpa::R3::ASF2::and_node_tag {
1924 0     0 0   my ( $asf, $and_node_id ) = @_;
1925              
1926 0           my ($tag) = $asf->call_by_tag( ( '@' . __FILE__ . ':' . __LINE__ ),
1927             << 'END_OF_LUA', 'i', $and_node_id );
1928             local asf, and_node_id=...
1929             return asf:and_node_tag(and_node_id)
1930             END_OF_LUA
1931              
1932 0           return $tag;
1933             }
1934              
1935             # not to be documented
1936             sub Marpa::R3::ASF2::verbose_or_node {
1937 0     0 0   my ( $asf, $or_node_id ) = @_;
1938 0           my $slr = $asf->[Marpa::R3::Internal_ASF2::SLR];
1939 0           my $slg = $slr->[Marpa::R3::Internal_R::SLG];
1940              
1941 0           my ($text, $nrl_id, $position)
1942             = $asf->call_by_tag(
1943             ('@' . __FILE__ . ':' . __LINE__),
1944             <<'END_OF_LUA', 'i', $or_node_id);
1945             local asf, or_node_id = ...
1946             local slr = asf.slr
1947             local bocage = asf.lmw_b
1948             local origin = bocage:_or_node_origin(or_node_id)
1949             if not origin then return end
1950             local set = bocage:_or_node_set(or_node_id)
1951             local position = bocage:_or_node_position(or_node_id)
1952             local g1r = slr.g1
1953             local origin_earleme = g1r:earleme(origin)
1954             local current_earleme = g1r:earleme(set)
1955             local text = string.format(
1956             'OR-node #%d: R%d:@%d-%d\n',
1957             or_node_id,
1958             position,
1959             origin_earleme,
1960             current_earleme,
1961             )
1962              
1963             END_OF_LUA
1964 0 0         return if not $text;
1965              
1966 0           $text .= ( q{ } x 4 )
1967             . $slg->dotted_nrl_show( $nrl_id, $position ) . "\n";
1968 0           return $text;
1969             }
1970              
1971             # not to be documented
1972             sub Marpa::R3::ASF2::bocage_show {
1973 0     0 0   my ($asf) = @_;
1974              
1975 0           my ($result) = $asf->call_by_tag(
1976             ('@' . __FILE__ . ':' . __LINE__),
1977             <<'END_OF_LUA', '');
1978             local asf = ...
1979             return asf:bocage_show()
1980             END_OF_LUA
1981              
1982 0           return $result;
1983             }
1984              
1985             # not to be documented
1986             sub Marpa::R3::ASF2::or_nodes_show {
1987 0     0 0   my ( $asf ) = @_;
1988              
1989 0           my ($result) = $asf->call_by_tag(
1990             ('@' . __FILE__ . ':' . __LINE__),
1991             <<'END_OF_LUA', '');
1992             local asf = ...
1993             return asf:or_nodes_show()
1994             END_OF_LUA
1995              
1996 0           return $result;
1997             }
1998              
1999             # not to be documented
2000             sub Marpa::R3::ASF2::and_nodes_show {
2001 0     0 0   my ( $asf ) = @_;
2002 0           my ($result) = $asf->call_by_tag(
2003             ('@' . __FILE__ . ':' . __LINE__),
2004             <<'END_OF_LUA', '');
2005             local asf = ...
2006             return asf:and_nodes_show()
2007             END_OF_LUA
2008              
2009 0           return $result;
2010             }
2011              
2012             sub Marpa::R3::ASF2::ambiguity_level {
2013 0     0 0   my ($asf) = @_;
2014              
2015 0           my ($metric) = $asf->call_by_tag(
2016             ('@' . __FILE__ . ':' . __LINE__),
2017             <<'END__OF_LUA', '>*' );
2018             local asf = ...
2019             return asf:ambiguity_level()
2020             END__OF_LUA
2021 0           return $metric;
2022             }
2023              
2024             sub Marpa::R3::ASF2::g1_pos {
2025 0     0 0   my ( $asf ) = @_;
2026 0           my ($g1_pos) = $asf->call_by_tag(
2027             ('@' . __FILE__ . ':' . __LINE__),
2028             <<'END__OF_LUA', '>*' );
2029             local asf = ...
2030             return asf:g1_pos()
2031             END__OF_LUA
2032 0           return $g1_pos;
2033             }
2034              
2035             # not to be documented
2036             sub Marpa::R3::ASF2::regix {
2037 0     0 0   my ( $asf ) = @_;
2038 0           my $regix = $asf->[Marpa::R3::Internal_ASF2::REGIX];
2039 0           return $regix;
2040             }
2041              
2042             1;
2043              
2044             # vim: expandtab shiftwidth=4: