File Coverage

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