1package Marpa::Evaluator; 2 3use 5.010; 4use warnings; 5 6# There's a problem witht his perlcritic check -- 7# as of 9 Aug 2010 it produces false negatives. 8## no critic (TestingAndDebugging::ProhibitNoWarnings) 9no warnings qw(recursion qw); 10## use critic 11 12use strict; 13use integer; 14 15use Marpa::Internal::Carp_Not; 16 17# The bocage is Marpa's structure for keeping multiple parses. 18# A parse bocage is a list of or-nodes, whose child 19# and-nodes must be (at most) binary. 20 21# "Parse forests" are the structures used to keep multiple 22# parses in many parsers, but Marpa 23# can't use them because 24# Marpa allows cyclical parses, and 25# it breaks the RHS of productions into 26# and-nodes of a most two symbols. 27# And-nodes start in binary form 28# in the Aycock-Horspool Earley items, and because 29# binary and-nodes store the parses 30# compactly, and allow easier tree 31# traversals, I keep them that way. 32 33# Bocage is a special type of forest, 34# consisting of hedgerows deliberately cultivated 35# as obstacles to cattle and armies. 36 37# Saplings which become or-nodes when they grow up. 38 39use Marpa::Offset qw( 40 41 :package=Marpa::Internal::Or_Sapling 42 43 NAME ITEM RULE 44 POSITION CHILD_LHS_SYMBOL 45 46); 47 48use Marpa::Offset qw( 49 50 :package=Marpa::Internal::Eval_And_Node 51 52 ID 53 TAG 54 RULE_ID 55 TOKEN_NAME 56 VALUE_REF 57 VALUE_OPS 58 59 { Fields before this (except ID) 60 are used in evaluate() 61 and must be in the same location 62 for both Recce_And_Node and And_Node. 63 ID is included for orthogonality. } 64 65 START_EARLEME 66 END_EARLEME 67 CAUSE_EARLEME 68 69 POSITION { 70 Position in an and-node is not the same as 71 position in a rule. Rule positions are locations BETWEEN 72 symbols, and start from 0 (before the first symbol). 73 And-node positions are zero-based locations OF symbols. 74 An and-node position of -1 means the and-node is for a 75 rule with an empty RHS. } 76 77 FIXED_RANKING_DATA { Rank for this and-node itself, 78 but not including any of the children. 79 It takes into account the token, if any, 80 but not the rank of any of the children. 81 Once calculated, it's a constant 82 for the life of the and-node. 83 } 84 85 RANKING_CLOSURE 86 87 CAUSE_ID 88 PREDECESSOR_ID 89 TREE_OPS 90 PARENT_ID 91 PARENT_CHOICE 92 DELETED 93 94 =LAST_FIELD 95 96); 97 98use Marpa::Offset qw) 99 100 :package=Marpa::Internal::Original_Sort_Data 101 SORT_KEY 102 TRAILING_NULLS 103); 104 105use Marpa::Offset qw( 106 107 :package=Marpa::Internal::And_Iteration 108 109 RANKING_DATA 110 CURRENT_CHILD_FIELD 111 112 =LAST_FIELD 113 114); 115 116use Marpa::Offset qw( 117 118 :package=Marpa::Internal::Eval_Or_Node 119 120 TAG 121 ID 122 CHILD_IDS 123 START_EARLEME 124 END_EARLEME 125 PARENT_IDS 126 DELETED 127 128 =LAST_GENERAL_EVALUATOR_FIELD 129 =LAST_FIELD 130); 131 132use Marpa::Offset qw( 133 134 :package=Marpa::Internal::Or_Iteration 135 136 AND_CHOICE0 137 AND_CHOICE1 138 { And so on ... } 139 140); 141 142use Marpa::Offset qw( 143 :package=Marpa::Internal::And_Choice 144 ID 145 RANKING_DATA 146 FROZEN_ITERATION 147 =LAST_FIELD 148); 149 150use Marpa::Offset qw( 151 152 :package=Marpa::Internal::Evaluator 153 154 GRAMMAR 155 SEMANTICS_SETTLED 156 PARSE_COUNT :{ number of parses in an ambiguous parse :} 157 AND_NODES 158 OR_NODES 159 RULE_TREE_OPS 160 RULE_VALUE_OPS 161 AND_ITERATIONS 162 OR_ITERATIONS 163 ACTION_OBJECT_CONSTRUCTOR 164 RANKING_CLOSURES_BY_RULE :{ array, by rule id } 165 RANKING_CLOSURES_BY_SYMBOL :{ array, by symbol id } 166 167 INFINITE_NODES 168 INFINITE_REWRITE 169 INFINITE_SCALE 170 EXPERIMENTAL 171 MAX_PARSES 172 PARSE_ORDER 173 TRACING 174 TRACE_ACTIONS 175 TRACE_EVALUATION 176 TRACE_FILE_HANDLE 177 TRACE_TASKS 178 TRACE_VALUES 179 180); 181 182use Marpa::Offset qw( 183 184 :package=Marpa::Internal::Evaluator_Op 185 186 :{ These are the valuation-time ops } 187 ARGC 188 CALL 189 CONSTANT_RESULT 190 VIRTUAL_HEAD 191 VIRTUAL_HEAD_NO_SEP 192 VIRTUAL_KERNEL 193 VIRTUAL_TAIL 194 195 :{ These are the tree-time ops } 196 CYCLE 197 COUNTED_RULE 198 199); 200 201package Marpa::Internal::Evaluator; 202 203use English qw( -no_match_vars ); 204use Marpa::Internal::Carp_Not; 205 206our $DEFAULT_ACTION_VALUE = \undef; 207 208sub set_null_values { 209 my ($grammar) = @_; 210 211 my $rules = $grammar->[Marpa::Internal::Grammar::RULES]; 212 my $symbols = $grammar->[Marpa::Internal::Grammar::SYMBOLS]; 213 my $default_null_value = 214 $grammar->[Marpa::Internal::Grammar::DEFAULT_NULL_VALUE]; 215 my $actions_package = $grammar->[Marpa::Internal::Grammar::ACTIONS]; 216 217 my $null_values; 218 $#{$null_values} = $#{$symbols}; 219 220 SYMBOL: for my $symbol ( @{$symbols} ) { 221 next SYMBOL if not $symbol->[Marpa::Internal::Symbol::NULLING]; 222 223 my $null_value = undef; 224 if ( $symbol->[Marpa::Internal::Symbol::NULL_VALUE] ) { 225 $null_value = ${ $symbol->[Marpa::Internal::Symbol::NULL_VALUE] }; 226 } 227 else { 228 $null_value = $default_null_value; 229 } 230 next SYMBOL if not defined $null_value; 231 232 my $symbol_id = $symbol->[Marpa::Internal::Symbol::ID]; 233 $null_values->[$symbol_id] = $null_value; 234 235 if ($Marpa::Internal::TRACE_VALUES) { 236 print {$Marpa::Internal::TRACE_FH} 237 'Setting null value for symbol ', 238 $symbol->[Marpa::Internal::Symbol::NAME], 239 ' to ', 240 Data::Dumper->new( [ \$null_value ] )->Terse(1)->Dump, "\n" 241 or Marpa::exception('Could not print to trace file'); 242 } ## end if ($Marpa::Internal::TRACE_VALUES) 243 244 } ## end for my $symbol ( @{$symbols} ) 245 246 return $null_values; 247 248} # set_null_values 249 250# Given the grammar and an action name, resolve it to a closure, 251# or return undef 252sub resolve_semantics { 253 my ( $grammar, $closure_name ) = @_; 254 255 Marpa::exception(q{Trying to resolve 'undef' as closure name}) 256 if not defined $closure_name; 257 258 if ( my $closure = $Marpa::Internal::EXPLICIT_CLOSURES->{$closure_name} ) 259 { 260 if ($Marpa::Internal::TRACE_ACTIONS) { 261 print {$Marpa::Internal::TRACE_FH} 262 qq{Resolved "$closure_name" to explicit closure\n} 263 or Marpa::exception('Could not print to trace file'); 264 } 265 266 return $closure; 267 } ## end if ( my $closure = $Marpa::Internal::EXPLICIT_CLOSURES...) 268 269 my $fully_qualified_name; 270 DETERMINE_FULLY_QUALIFIED_NAME: { 271 if ( $closure_name =~ /([:][:])|[']/xms ) { 272 $fully_qualified_name = $closure_name; 273 last DETERMINE_FULLY_QUALIFIED_NAME; 274 } 275 if (defined( 276 my $actions_package = 277 $grammar->[Marpa::Internal::Grammar::ACTIONS] 278 ) 279 ) 280 { 281 $fully_qualified_name = $actions_package . q{::} . $closure_name; 282 last DETERMINE_FULLY_QUALIFIED_NAME; 283 } ## end if ( defined( my $actions_package = $grammar->[...])) 284 285 if (defined( 286 my $action_object = 287 $grammar->[Marpa::Internal::Grammar::ACTION_OBJECT] 288 ) 289 ) 290 { 291 $fully_qualified_name = $action_object . q{::} . $closure_name; 292 } ## end if ( defined( my $action_object = $grammar->[...])) 293 } ## end DETERMINE_FULLY_QUALIFIED_NAME: 294 295 return if not defined $fully_qualified_name; 296 297 no strict 'refs'; 298 my $closure = *{$fully_qualified_name}{'CODE'}; 299 use strict 'refs'; 300 301 if ($Marpa::Internal::TRACE_ACTIONS) { 302 print {$Marpa::Internal::TRACE_FH} 303 ( $closure ? 'Successful' : 'Failed' ) 304 . qq{ resolution of "$closure_name" }, 305 'to ', $fully_qualified_name, "\n" 306 or Marpa::exception('Could not print to trace file'); 307 } ## end if ($Marpa::Internal::TRACE_ACTIONS) 308 309 return $closure; 310 311} ## end sub resolve_semantics 312 313sub set_actions { 314 my ($grammar) = @_; 315 316 my ( $rules, $default_action, ) = @{$grammar}[ 317 Marpa::Internal::Grammar::RULES, 318 Marpa::Internal::Grammar::DEFAULT_ACTION, 319 ]; 320 321 my $evaluator_rules = []; 322 323 my $default_action_closure; 324 if ( defined $default_action ) { 325 $default_action_closure = 326 Marpa::Internal::Evaluator::resolve_semantics( $grammar, 327 $default_action ); 328 Marpa::exception( 329 "Could not resolve default action named '$default_action'") 330 if not $default_action_closure; 331 } ## end if ( defined $default_action ) 332 333 RULE: for my $rule ( @{$rules} ) { 334 335 next RULE if not $rule->[Marpa::Internal::Rule::USED]; 336 337 my $rule_id = $rule->[Marpa::Internal::Rule::ID]; 338 my $ops = $evaluator_rules->[$rule_id] = []; 339 340 my $virtual_rhs = $rule->[Marpa::Internal::Rule::VIRTUAL_RHS]; 341 my $virtual_lhs = $rule->[Marpa::Internal::Rule::VIRTUAL_LHS]; 342 343 if ($virtual_lhs) { 344 push @{$ops}, 345 ( 346 $virtual_rhs 347 ? Marpa::Internal::Evaluator_Op::VIRTUAL_KERNEL 348 : Marpa::Internal::Evaluator_Op::VIRTUAL_TAIL 349 ), 350 $rule->[Marpa::Internal::Rule::REAL_SYMBOL_COUNT]; 351 next RULE; 352 } ## end if ($virtual_lhs) 353 354 # If we are here the LHS is real, not virtual 355 356 if ($virtual_rhs) { 357 push @{$ops}, 358 ( 359 $rule->[Marpa::Internal::Rule::DISCARD_SEPARATION] 360 ? Marpa::Internal::Evaluator_Op::VIRTUAL_HEAD_NO_SEP 361 : Marpa::Internal::Evaluator_Op::VIRTUAL_HEAD 362 ), 363 $rule->[Marpa::Internal::Rule::REAL_SYMBOL_COUNT]; 364 } ## end if ($virtual_rhs) 365 # assignment instead of comparison is deliberate 366 elsif ( my $argc = scalar @{ $rule->[Marpa::Internal::Rule::RHS] } ) { 367 push @{$ops}, Marpa::Internal::Evaluator_Op::ARGC, $argc; 368 } 369 370 if ( my $action = $rule->[Marpa::Internal::Rule::ACTION] ) { 371 my $closure = 372 Marpa::Internal::Evaluator::resolve_semantics( $grammar, 373 $action ); 374 375 Marpa::exception(qq{Could not resolve action name: "$action"}) 376 if not defined $closure; 377 push @{$ops}, Marpa::Internal::Evaluator_Op::CALL, $closure; 378 next RULE; 379 } ## end if ( my $action = $rule->[Marpa::Internal::Rule::ACTION...]) 380 381 # Try to resolve the LHS as a closure name, 382 # if it is not internal. 383 # If we can't resolve 384 # the LHS as a closure name, it's not 385 # a fatal error. 386 if ( my $action = 387 $rule->[Marpa::Internal::Rule::LHS] 388 ->[Marpa::Internal::Symbol::NAME] ) 389 { 390 if ($action !~ /[\]] \z/xms 391 and defined( 392 my $closure = 393 Marpa::Internal::Evaluator::resolve_semantics( 394 $grammar, $action 395 ) 396 ) 397 ) 398 { 399 push @{$ops}, Marpa::Internal::Evaluator_Op::CALL, $closure; 400 next RULE; 401 } ## end if ( $action !~ /[\]] \z/xms and defined( my $closure...)[) 402 } ## end if ( my $action = $rule->[Marpa::Internal::Rule::LHS...]) 403 404 if ( defined $default_action_closure ) { 405 push @{$ops}, Marpa::Internal::Evaluator_Op::CALL, 406 $default_action_closure; 407 next RULE; 408 } 409 410 # If there is no default action specified, the fallback 411 # is to return an undef 412 push @{$ops}, Marpa::Internal::Evaluator_Op::CONSTANT_RESULT, 413 $Marpa::Internal::Evaluator::DEFAULT_ACTION_VALUE; 414 415 } ## end for my $rule ( @{$rules} ) 416 417 return $evaluator_rules; 418 419} # set_actions 420 421sub audit_or_node { 422 my ( $evaler, $or_node ) = @_; 423 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 424 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 425 426 my $or_node_id = $or_node->[Marpa::Internal::Eval_Or_Node::ID]; 427 428 if ( not defined $or_node_id ) { 429 Marpa::exception('ID not defined in or-node'); 430 } 431 my $or_nodes_entry = $or_nodes->[$or_node_id]; 432 if ( $or_node != $or_nodes_entry ) { 433 Marpa::exception( 434 "or_node #$or_node_id does not match its or-nodes entry"); 435 } 436 if ( $#{$or_node} != Marpa::Internal::Eval_Or_Node::LAST_FIELD ) { 437 Marpa::exception( 438 "Bad field count in or-node #$or_node_id: want ", 439 Marpa::Internal::Eval_Or_Node::LAST_FIELD, 440 ', got ', $#{$or_node} 441 ); 442 } ## end if ( $#{$or_node} != Marpa::Internal::Eval_Or_Node::LAST_FIELD) 443 444 my $deleted = $or_node->[Marpa::Internal::Eval_Or_Node::DELETED]; 445 446 my $parent_ids = $or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 447 448 # No parents for top or-node, or-node 0 449 if ( $or_node_id != 0 ) { 450 my $has_parents = ( defined $parent_ids and scalar @{$parent_ids} ); 451 if ( not $deleted and not $has_parents ) { 452 Marpa::exception("or-node #$or_node_id has no parents"); 453 } 454 if ( $deleted and $has_parents ) { 455 Marpa::exception("Deleted or-node #$or_node_id has parents"); 456 } 457 } ## end if ( $or_node_id != 0 ) 458 459 { 460 my %parent_id_seen; 461 PARENT_ID: for my $parent_id ( @{$parent_ids} ) { 462 next PARENT_ID if not $parent_id_seen{$parent_id}++; 463 Marpa::exception( 464 "or-node #$or_node_id has duplicate parent, #$parent_id"); 465 } 466 } 467 468 PARENT_ID: for my $parent_id ( @{$parent_ids} ) { 469 my $parent = $and_nodes->[$parent_id]; 470 my $cause_id = $parent->[Marpa::Internal::Eval_And_Node::CAUSE_ID]; 471 next PARENT_ID if defined $cause_id and $or_node_id == $cause_id; 472 473 my $predecessor_id = 474 $parent->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID]; 475 next PARENT_ID 476 if defined $predecessor_id and $or_node_id == $predecessor_id; 477 478 Marpa::exception( 479 "or_node #$or_node_id is not the cause or predecessor of parent and-node #$parent_id" 480 ); 481 482 } ## end for my $parent_id ( @{$parent_ids} ) 483 484 my $child_ids = $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 485 my $has_children = ( defined $child_ids and scalar @{$child_ids} ); 486 if ( not $deleted and not $has_children ) { 487 Marpa::exception("or-node #$or_node_id has no children"); 488 } 489 if ( $deleted and $has_children ) { 490 Marpa::exception("Deleted or-node #$or_node_id has children"); 491 } 492 493 { 494 my %child_id_seen; 495 CHILD_ID: for my $child_id ( @{$child_ids} ) { 496 next CHILD_ID if not $child_id_seen{$child_id}++; 497 Marpa::exception( 498 "or-node #$or_node_id has duplicate child, #$child_id"); 499 } 500 } 501 502 for my $child_id ( @{$child_ids} ) { 503 my $child = $and_nodes->[$child_id]; 504 my $child_parent = 505 $child->[Marpa::Internal::Eval_And_Node::PARENT_ID]; 506 if ( not defined $child_parent or $or_node_id != $child_parent ) { 507 Marpa::exception( 508 "or_node #$or_node_id is not the parent of child and-node #$child_id" 509 ); 510 } 511 } ## end for my $child_id ( @{$child_ids} ) 512 513 return; 514} ## end sub audit_or_node 515 516sub audit_and_node { 517 my ( $evaler, $audit_and_node ) = @_; 518 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 519 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 520 521 my $audit_and_node_id = 522 $audit_and_node->[Marpa::Internal::Eval_And_Node::ID]; 523 524 if ( not defined $audit_and_node_id ) { 525 Marpa::exception('ID not defined in and-node'); 526 } 527 my $and_nodes_entry = $and_nodes->[$audit_and_node_id]; 528 if ( $audit_and_node != $and_nodes_entry ) { 529 Marpa::exception( 530 "and_node #$audit_and_node_id does not match its and-nodes entry" 531 ); 532 } 533 if ( $#{$audit_and_node} != Marpa::Internal::Eval_And_Node::LAST_FIELD ) { 534 Marpa::exception( 535 "Bad field count in and-node #$audit_and_node_id: want ", 536 Marpa::Internal::Eval_And_Node::LAST_FIELD, 537 ', got ', 538 $#{$audit_and_node} 539 ); 540 } ## end if ( $#{$audit_and_node} != ...) 541 542 my $deleted = $audit_and_node->[Marpa::Internal::Eval_And_Node::DELETED]; 543 544 my $parent_id = 545 $audit_and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID]; 546 my $parent_choice = 547 $audit_and_node->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE]; 548 if ( not $deleted ) { 549 my $parent_or_node = $or_nodes->[$parent_id]; 550 my $parent_idea_of_child_id = 551 $parent_or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] 552 ->[$parent_choice]; 553 if ( $audit_and_node_id != $parent_idea_of_child_id ) { 554 Marpa::exception( 555 "and_node #$audit_and_node_id does not match its CHILD_IDS entry in its parent" 556 ); 557 } 558 } ## end if ( not $deleted ) 559 else { 560 if ( defined $parent_id ) { 561 Marpa::exception( 562 "deleted and_node $audit_and_node_id has defined PARENT_ID: #$parent_id" 563 ); 564 } 565 if ( defined $parent_choice ) { 566 Marpa::exception( 567 "deleted and_node $audit_and_node_id has defined PARENT_CHOICE: #$parent_choice" 568 ); 569 } 570 } ## end else [ if ( not $deleted ) ] 571 572 FIELD: 573 for my $field ( 574 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 575 Marpa::Internal::Eval_And_Node::CAUSE_ID, 576 ) 577 { 578 my $child_or_node_id = $audit_and_node->[$field]; 579 next FIELD if not defined $child_or_node_id; 580 my $child_or_node = $or_nodes->[$child_or_node_id]; 581 if ( $deleted and defined $child_or_node_id ) { 582 Marpa::exception( 583 "deleted and-node $audit_and_node_id has defined child: #$parent_id" 584 ); 585 } 586 my $child_idea_of_parent_ids = 587 $child_or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 588 if ( $deleted and scalar @{$child_idea_of_parent_ids} ) { 589 Marpa::exception( 590 "deleted and-node $audit_and_node_id has parents: ", 591 ( join q{, }, @{$child_idea_of_parent_ids} ) 592 ); 593 } ## end if ( $deleted and scalar @{$child_idea_of_parent_ids...}) 594 next FIELD if $deleted; 595 my $audit_and_node_index = List::Util::first { 596 $child_idea_of_parent_ids->[$_] == $audit_and_node_id; 597 } 598 ( 0 .. $#{$child_idea_of_parent_ids} ); 599 if ( not defined $audit_and_node_index ) { 600 Marpa::exception( 601 "child of and-node (or-node $child_or_node_id) does not have and-node $audit_and_node_id as parent" 602 ); 603 } 604 605 } ## end for my $field ( Marpa::Internal::Eval_And_Node::PREDECESSOR_ID...) 606 607 return; 608} ## end sub audit_and_node 609 610sub Marpa::Evaluator::audit { 611 my ($evaler) = @_; 612 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 613 for my $or_node ( @{$or_nodes} ) { 614 audit_or_node( $evaler, $or_node ); 615 } 616 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 617 for my $and_node ( @{$and_nodes} ) { 618 audit_and_node( $evaler, $and_node ); 619 } 620 621 ### Bocage passed audit ... 622 623 return; 624} ## end sub Marpa::Evaluator::audit 625 626# Internal routine to clone an and-node 627sub clone_and_node { 628 my ( $evaler, $and_node, $new_parent_or_node_id, 629 $child_or_node_id_translation ) 630 = @_; 631 632 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 633 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 634 635 my $new_and_node; 636 $#{$new_and_node} = Marpa::Internal::Eval_And_Node::LAST_FIELD; 637 my $new_and_node_id = 638 $new_and_node->[Marpa::Internal::Eval_And_Node::ID] = 639 scalar @{$and_nodes}; 640 641 push @{$and_nodes}, $new_and_node; 642 643 for my $field ( 644 Marpa::Internal::Eval_And_Node::VALUE_REF, 645 Marpa::Internal::Eval_And_Node::TOKEN_NAME, 646 Marpa::Internal::Eval_And_Node::TREE_OPS, 647 Marpa::Internal::Eval_And_Node::VALUE_OPS, 648 Marpa::Internal::Eval_And_Node::START_EARLEME, 649 Marpa::Internal::Eval_And_Node::END_EARLEME, 650 Marpa::Internal::Eval_And_Node::CAUSE_EARLEME, 651 Marpa::Internal::Eval_And_Node::RULE_ID, 652 Marpa::Internal::Eval_And_Node::POSITION, 653 Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA, 654 Marpa::Internal::Eval_And_Node::RANKING_CLOSURE, 655 ) 656 { 657 $new_and_node->[$field] = $and_node->[$field]; 658 } ## end for my $field ( Marpa::Internal::Eval_And_Node::VALUE_REF...) 659 660 # link the newly cloned and-node to 661 # its or-node parent 662 $new_parent_or_node_id //= 663 $and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID]; 664 665 my $new_parent_or_node = $or_nodes->[$new_parent_or_node_id]; 666 my $siblings = 667 $new_parent_or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 668 669 $new_and_node->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE] = 670 @{$siblings}; 671 $new_and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID] = 672 $new_parent_or_node_id; 673 push @{$siblings}, $new_and_node_id; 674 675 my $tag = $and_node->[Marpa::Internal::Eval_And_Node::TAG]; 676 $tag =~ s{ [o] \d+ [a] \d+ \z }{}xms; 677 $tag .= 'o' . $new_parent_or_node_id . 'a' . $new_and_node_id; 678 $new_and_node->[Marpa::Internal::Eval_And_Node::TAG] = $tag; 679 680 # link the newly cloned and-node 681 # to its or-node children 682 $child_or_node_id_translation //= {}; 683 FIELD: 684 for my $field ( 685 Marpa::Internal::Eval_And_Node::CAUSE_ID, 686 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 687 ) 688 { 689 my $old_child_or_node_id = $and_node->[$field]; 690 next FIELD if not defined $old_child_or_node_id; 691 my $new_child_or_node_id = 692 $child_or_node_id_translation->{$old_child_or_node_id}; 693 $new_child_or_node_id //= $old_child_or_node_id; 694 695 my $new_or_child = $or_nodes->[$new_child_or_node_id]; 696 697 $new_and_node->[$field] = $new_child_or_node_id; 698 push @{ $new_or_child->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] }, 699 $new_and_node_id; 700 } ## end for my $field ( Marpa::Internal::Eval_And_Node::CAUSE_ID...) 701 702 return $new_and_node; 703} ## end sub clone_and_node 704 705# Returns the number of nodes actually deleted 706sub delete_nodes { 707 my ( $evaler, $delete_work_list ) = @_; 708 709 # Should be deletion-consistent at this point 710 #### assert: Marpa'Evaluator'audit($evaler) or 1 711 712 my $deleted_count = 0; 713 714 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 715 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 716 DELETE_WORK_ITEM: 717 while ( my $delete_work_item = pop @{$delete_work_list} ) { 718 my ( $node_type, $delete_node_id ) = @{$delete_work_item}; 719 720 if ( $node_type eq 'a' ) { 721 722 my $delete_and_node = $and_nodes->[$delete_node_id]; 723 724 next DELETE_WORK_ITEM 725 if 726 $delete_and_node->[Marpa::Internal::Eval_And_Node::DELETED]; 727 728 my $parent_id = 729 $delete_and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID]; 730 my $parent_or_node = $or_nodes->[$parent_id]; 731 732 if (not $parent_or_node->[Marpa::Internal::Eval_Or_Node::DELETED] 733 ) 734 { 735 push @{$delete_work_list}, [ 'o', $parent_id ]; 736 my $parent_choice = $delete_and_node 737 ->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE]; 738 739 my $parent_child_ids = $parent_or_node 740 ->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 741 742 splice @{$parent_child_ids}, $parent_choice, 1; 743 744 # Eliminating one of the choices means all subsequent ones 745 # are renumbered -- adjust accordingly. 746 for my $choice ( $parent_choice .. $#{$parent_child_ids} ) { 747 my $sibling_and_node_id = $parent_child_ids->[$choice]; 748 my $sibling_and_node = $and_nodes->[$sibling_and_node_id]; 749 $sibling_and_node 750 ->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE] = 751 $choice; 752 753 } ## end for my $choice ( $parent_choice .. $#{...}) 754 755 } ## end if ( not $parent_or_node->[...]) 756 757 FIELD: 758 for my $field ( 759 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 760 Marpa::Internal::Eval_And_Node::CAUSE_ID, 761 ) 762 { 763 my $child_or_node_id = $delete_and_node->[$field]; 764 next FIELD if not defined $child_or_node_id; 765 my $child_or_node = $or_nodes->[$child_or_node_id]; 766 next FIELD 767 if 768 $child_or_node->[Marpa::Internal::Eval_Or_Node::DELETED]; 769 770 push @{$delete_work_list}, [ 'o', $child_or_node_id ]; 771 772 # Splice out the reference to this or-node in the PARENT_IDS 773 # field of the or-node child 774 my $parent_ids = $child_or_node 775 ->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 776 777 my $delete_node_index = 778 List::Util::first { $parent_ids->[$_] == $delete_node_id } 779 ( 0 .. $#{$parent_ids} ); 780 781 splice @{$parent_ids}, $delete_node_index, 1; 782 } # FIELD 783 784 FIELD: 785 for my $field ( 786 Marpa::Internal::Eval_And_Node::PARENT_ID, 787 Marpa::Internal::Eval_And_Node::PARENT_CHOICE, 788 Marpa::Internal::Eval_And_Node::CAUSE_ID, 789 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 790 Marpa::Internal::Eval_And_Node::VALUE_REF, 791 Marpa::Internal::Eval_And_Node::TOKEN_NAME, 792 ) 793 { 794 $delete_and_node->[$field] = undef; 795 } ## end for my $field ( ...) 796 797 $delete_and_node->[Marpa::Internal::Eval_And_Node::DELETED] = 1; 798 $deleted_count++; 799 800 next DELETE_WORK_ITEM; 801 } ## end if ( $node_type eq 'a' ) 802 803 if ( $node_type eq 'o' ) { 804 805 my $or_node = $or_nodes->[$delete_node_id]; 806 next DELETE_WORK_ITEM 807 if $or_node->[Marpa::Internal::Eval_Or_Node::DELETED]; 808 my $parent_ids = 809 $or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 810 my $child_ids = 811 $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 812 813 # Do not delete unless no children, or no parents and not the 814 # start or-node. 815 # Start or-node is always ID 0. 816 817 next DELETE_WORK_ITEM 818 if ( scalar @{$parent_ids} or $delete_node_id == 0 ) 819 and scalar @{$child_ids}; 820 821 $or_node->[Marpa::Internal::Eval_Or_Node::DELETED] = 1; 822 $deleted_count++; 823 824 push @{$delete_work_list}, 825 map { [ 'a', $_ ] } @{$parent_ids}, @{$child_ids}; 826 for my $field ( 827 Marpa::Internal::Eval_Or_Node::PARENT_IDS, 828 Marpa::Internal::Eval_Or_Node::CHILD_IDS, 829 ) 830 { 831 $or_node->[$field] = []; 832 } ## end for my $field ( ...) 833 834 next DELETE_WORK_ITEM; 835 } ## end if ( $node_type eq 'o' ) 836 837 Marpa::exception("Unknown delete-work-list node-type: $node_type"); 838 } ## end while ( my $delete_work_item = pop @{$delete_work_list}) 839 return $deleted_count; 840} ## end sub delete_nodes 841 842# Rewrite to eliminate cycles. 843sub rewrite_infinite { 844 my ( $evaler, $infinite_rule_ids ) = @_; 845 846 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 847 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 848 849 my $trace_evaluation; 850 851 my $grammar = $evaler->[Marpa::Internal::Evaluator::GRAMMAR]; 852 my $warn_on_infinite = 853 $grammar->[Marpa::Internal::Grammar::INFINITE_ACTION] ne 'quiet'; 854 $trace_evaluation = 855 $evaler->[Marpa::Internal::Evaluator::TRACE_EVALUATION]; 856 857 my $initial_and_nodes = @{$and_nodes}; 858 my $maximum_and_nodes = List::Util::max( 859 $initial_and_nodes 860 + $evaler->[Marpa::Internal::Evaluator::INFINITE_NODES], 861 $initial_and_nodes 862 * $evaler->[Marpa::Internal::Evaluator::INFINITE_SCALE] 863 ); 864 865 my @infinite_rules; 866 @infinite_rules[ @{$infinite_rule_ids} ] = 867 (1) x scalar @{$infinite_rule_ids}; 868 my @infinite_or_nodes = 869 grep { not $_->[Marpa::Internal::Eval_Or_Node::DELETED] } 870 map { $or_nodes->[ $_->[Marpa::Internal::Eval_And_Node::PARENT_ID] ] } 871 grep { 872 not $_->[Marpa::Internal::Eval_And_Node::DELETED] 873 and 874 $infinite_rules[ $_->[Marpa::Internal::Eval_And_Node::RULE_ID] ] 875 } @{$and_nodes}; 876 877 # Group or-nodes by span. Only or-nodes with the same 878 # span can be in a cycle. 879 my %or_nodes_by_span; 880 for my $or_node (@infinite_or_nodes) { 881 push @{ 882 $or_nodes_by_span{ 883 join q{,}, 884 @{$or_node}[ 885 Marpa::Internal::Eval_Or_Node::START_EARLEME, 886 Marpa::Internal::Eval_Or_Node::END_EARLEME 887 ] 888 } 889 }, 890 $or_node; 891 } ## end for my $or_node (@infinite_or_nodes) 892 893 # Initialize the span sets 894 my @span_sets = values %or_nodes_by_span; 895 896 SPAN_SET: while ( my $span_set = pop @span_sets ) { 897 @{$span_set} = 898 grep { not $_->[Marpa::Internal::Eval_Or_Node::DELETED] } 899 @{$span_set}; 900 next SPAN_SET if not @{$span_set}; 901 902 my %in_span_set = (); 903 for my $or_node_ix ( 0 .. $#{$span_set} ) { 904 my $or_node_id = 905 $span_set->[$or_node_ix]->[Marpa::Internal::Eval_Or_Node::ID]; 906 907 $in_span_set{$or_node_id} = $or_node_ix; 908 } ## end for my $or_node_ix ( 0 .. $#{$span_set} ) 909 910 # Set up matrix of or-node to or-node transitions. 911 my @transition; 912 my @work_list; 913 for my $or_parent_ix ( 0 .. $#{$span_set} ) { 914 my @or_child_ixes = 915 grep { defined $_ } 916 map { $in_span_set{$_} } 917 grep { defined $_ } 918 map { 919 @{$_}[ 920 Marpa::Internal::Eval_And_Node::CAUSE_ID, 921 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 922 ] 923 } @{$and_nodes}[ 924 @{ $span_set->[$or_parent_ix] 925 ->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] } 926 ]; 927 for my $or_child_ix (@or_child_ixes) { 928 $transition[$or_parent_ix][$or_child_ix]++; 929 push @work_list, [ $or_parent_ix, $or_child_ix ]; 930 } 931 } ## end for my $or_parent_ix ( 0 .. $#{$span_set} ) 932 933 # Compute transitive closure of matrix of or-node transitions. 934 while ( my $work_item = pop @work_list ) { 935 my ( $from_ix, $to_ix ) = @{$work_item}; 936 GRAND_CHILD: 937 for my $new_to_ix ( grep { $transition[$to_ix][$_] } 938 ( 0 .. $#{$span_set} ) ) 939 { 940 my $transition_row = $transition[$from_ix]; 941 next GRAND_CHILD if $transition_row->[$new_to_ix]; 942 $transition_row->[$new_to_ix]++; 943 push @work_list, [ $from_ix, $new_to_ix ]; 944 } ## end for my $new_to_ix ( grep { $transition[$to_ix][$_] } ...) 945 } ## end while ( my $work_item = pop @work_list ) 946 947 # Use the transitions to find the cycles in the span set 948 my @cycle; 949 { 950 my $span_set_index = 951 List::Util::first { $transition[$_][$_] } 952 ( 0 .. $#{$span_set} ); 953 next SPAN_SET if not defined $span_set_index; 954 @cycle = map { $span_set->[$_] } ( 955 $span_set_index, 956 grep { 957 $transition[$span_set_index][$_] 958 and $transition[$_][$span_set_index] 959 } ( $span_set_index + 1 .. $#{$span_set} ) 960 ); 961 } 962 963 if ($trace_evaluation) { 964 say {$Marpa::Internal::TRACE_FH} 'Found cycle of length ', 965 ( scalar @cycle ) 966 or Marpa::exception("Cannot print: $ERRNO"); 967 for my $ix ( 0 .. $#cycle ) { 968 my $or_node = $cycle[$ix]; 969 print {$Marpa::Internal::TRACE_FH} "Node $ix in cycle: ", 970 Marpa::Evaluator::show_or_node( $evaler, $or_node, 971 $trace_evaluation ) 972 or Marpa::exception('print to trace handle failed'); 973 } ## end for my $ix ( 0 .. $#cycle ) 974 } ## end if ($trace_evaluation) 975 976 # If we found any cycles in the span set, put the 977 # whole span set back 978 # on the work list for another pass 979 push @span_sets, $span_set; 980 981 # Find the internal and-nodes in the cycle 982 my %internal_and_nodes = (); 983 for my $or_node (@cycle) { 984 for my $and_node_id ( 985 @{ $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] } ) 986 { 987 $internal_and_nodes{$and_node_id} = 1; 988 } 989 } ## end for my $or_node (@cycle) 990 991 # Find the root or-nodes in the cycle 992 # They are the or-nodes, at least 993 # one of whose parent and-nodes 994 # are external. 995 my @root_or_nodes = grep { 996 grep { not( $_ ~~ \%internal_and_nodes ) } 997 @{ $_->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] } 998 } @cycle; 999 1000 ## deletion-consistent at this point 1001 #### assert: Marpa'Evaluator'audit($evaler) or 1 1002 1003 my @delete_work_list = (); 1004 1005 # now make the copies 1006 for my $copy ( 1 .. $#root_or_nodes ) { 1007 1008 my $original_root_or_node = $root_or_nodes[$copy]; 1009 my $original_root_or_node_id = 1010 $original_root_or_node->[Marpa::Internal::Eval_Or_Node::ID]; 1011 1012 # Copy non-link dependent fields 1013 # Make translation tables 1014 # Create interior and-node to or-node links 1015 my %translate_or_node_id; 1016 my %translate_and_node_id; 1017 1018 # store our new cycle set here, so we can add it 1019 # to the span set work list 1020 my @copied_cycle; 1021 1022 # Copy the or- and and-nodes and build the translation 1023 # tables. 1024 for my $or_node (@cycle) { 1025 my $or_node_id = 1026 $or_node->[Marpa::Internal::Eval_Or_Node::ID]; 1027 1028 my $new_or_node; 1029 $#{$new_or_node} = Marpa::Internal::Eval_Or_Node::LAST_FIELD; 1030 for my $field ( 1031 Marpa::Internal::Eval_Or_Node::START_EARLEME, 1032 Marpa::Internal::Eval_Or_Node::END_EARLEME, 1033 Marpa::Internal::Eval_Or_Node::TAG, 1034 ) 1035 { 1036 $new_or_node->[$field] = $or_node->[$field]; 1037 } ## end for my $field ( ...) 1038 1039 my $new_or_node_id = @{$or_nodes}; 1040 $new_or_node->[Marpa::Internal::Eval_Or_Node::ID] = 1041 $new_or_node_id; 1042 $new_or_node->[Marpa::Internal::Eval_Or_Node::TAG] =~ s{ 1043 [o] \d* \z 1044 }{o$new_or_node_id}xms; 1045 $new_or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] = []; 1046 1047 push @{$or_nodes}, $new_or_node; 1048 push @copied_cycle, $new_or_node; 1049 $translate_or_node_id{$or_node_id} = $new_or_node_id; 1050 } ## end for my $or_node (@cycle) 1051 1052 for my $old_or_node (@cycle) { 1053 my $old_or_node_id = 1054 $old_or_node->[Marpa::Internal::Eval_Or_Node::ID]; 1055 my $new_or_node_id = $translate_or_node_id{$old_or_node_id}; 1056 for my $old_child_and_node_id ( 1057 @{ $old_or_node 1058 ->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] 1059 } 1060 ) 1061 { 1062 my $old_child_and_node = 1063 $and_nodes->[$old_child_and_node_id]; 1064 1065 my $new_child_and_node = clone_and_node( 1066 $evaler, $old_child_and_node, 1067 $new_or_node_id, \%translate_or_node_id 1068 ); 1069 my $new_child_and_node_id = $new_child_and_node 1070 ->[Marpa::Internal::Eval_And_Node::ID]; 1071 if ( $new_child_and_node_id > $maximum_and_nodes ) { 1072 Marpa::exception( 1073 "Cycle produced too many nodes: $maximum_and_nodes\n", 1074 "Rewrite grammar or increase infinite_scale\n" 1075 ); 1076 } ## end if ( $new_child_and_node_id > $maximum_and_nodes ) 1077 $translate_and_node_id{$old_child_and_node_id} = 1078 $new_child_and_node_id; 1079 1080 } ## end for my $old_child_and_node_id ( @{ $old_or_node->[...]}) 1081 1082 } ## end for my $old_or_node (@cycle) 1083 1084 # Translate the cycle-internal links 1085 # and duplicate the outgoing external links (which 1086 # will be from the and-nodes) 1087 1088 for my $original_or_node (@cycle) { 1089 1090 my $original_or_node_id = 1091 $original_or_node->[Marpa::Internal::Eval_Or_Node::ID]; 1092 my $new_or_node_id = 1093 $translate_or_node_id{$original_or_node_id}; 1094 my $new_or_node = $or_nodes->[$new_or_node_id]; 1095 1096 # This throws away all external links to the or-nodes, 1097 # for the moment. Below, I'll re-add the ones for the 1098 # root node. 1099 $new_or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] = [ 1100 grep { defined $_ } 1101 map { $translate_and_node_id{$_} } @{ 1102 $original_or_node 1103 ->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] 1104 } 1105 ]; 1106 1107 } ## end for my $original_or_node (@cycle) 1108 1109 # It remains now to duplicate the external links to the cycle 1110 # and to mark internal links to the root node for deletion. 1111 # External links are allowed only to the root node of the cycle. 1112 1113 my $new_root_or_node_id = 1114 $translate_or_node_id{ $original_root_or_node 1115 ->[Marpa::Internal::Eval_Or_Node::ID] }; 1116 1117 my $new_root_or_node = $or_nodes->[$new_root_or_node_id]; 1118 1119 PARENT_AND_NODE: 1120 for my $original_parent_and_node_id ( 1121 @{ $original_root_or_node 1122 ->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] 1123 } 1124 ) 1125 { 1126 1127 # Internal nodes need to be put on the list to be deleted 1128 if (defined( 1129 my $new_parent_and_node_id = 1130 $translate_and_node_id{ 1131 $original_parent_and_node_id} 1132 ) 1133 ) 1134 { 1135 push @delete_work_list, [ 'a', $new_parent_and_node_id ]; 1136 next PARENT_AND_NODE; 1137 } ## end if ( defined( my $new_parent_and_node_id = ...)) 1138 1139 # If we are here, the parent node is cycle-external. 1140 1141 # Clone the external parent node 1142 my $old_parent_and_node = 1143 $and_nodes->[$original_parent_and_node_id]; 1144 my $new_parent_and_node = 1145 clone_and_node( $evaler, $old_parent_and_node, undef, 1146 { $original_root_or_node_id => $new_root_or_node_id } ); 1147 1148 Marpa::exception( 'Rewrite of intertwined nulling cycles', 1149 ' not yet implemented' ) 1150 if grep { defined and defined $translate_or_node_id{$_} } 1151 @{$new_parent_and_node}[ 1152 Marpa::Internal::Eval_And_Node::CAUSE_ID, 1153 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 1154 ]; 1155 1156 } ## end for my $original_parent_and_node_id ( @{ ...}) 1157 1158 push @span_sets, \@copied_cycle; 1159 1160 # Should be deletion-consistent at this point 1161 #### assert: Marpa'Evaluator'audit($evaler) or 1 1162 1163 } ## end for my $copy ( 1 .. $#root_or_nodes ) 1164 1165 ## DELETE non-root external link on original 1166 ## DELETE root internal links on original 1167 my $original_root_or_node = $root_or_nodes[0]; 1168 for my $original_or_node (@cycle) { 1169 my $is_root = $original_or_node == $original_root_or_node; 1170 PARENT_AND_NODE: 1171 for my $original_parent_and_node_id ( 1172 @{ $original_or_node 1173 ->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] 1174 } 1175 ) 1176 { 1177 1178 next PARENT_AND_NODE 1179 if $is_root 1180 xor $internal_and_nodes{$original_parent_and_node_id}; 1181 1182 push @delete_work_list, [ 'a', $original_parent_and_node_id ]; 1183 } ## end for my $original_parent_and_node_id ( @{ ...}) 1184 } ## end for my $original_or_node (@cycle) 1185 1186 # we should be deletion-consistent at this point 1187 1188 # Now actually do the deletions 1189 delete_nodes( $evaler, \@delete_work_list ); 1190 1191 # Should be deletion-consistent at this point 1192 #### assert: Marpa'Evaluator'audit($evaler) or 1 1193 1194 # Have we deleted the top or-node? 1195 # If so, there will be no parses. 1196 if ( $or_nodes->[0]->[Marpa::Internal::Eval_Or_Node::DELETED] ) { 1197 if ($warn_on_infinite) { 1198 print {$Marpa::Internal::TRACE_FH} 1199 "Cycles found, but no parses\n" 1200 or Marpa::exception('print to trace handle failed'); 1201 } 1202 return; 1203 } ## end if ( $or_nodes->[0]->[Marpa::Internal::Eval_Or_Node::DELETED...]) 1204 1205 } ## end while ( my $span_set = pop @span_sets ) 1206 1207 ### assert: Marpa'Evaluator'audit($evaler) or 1 1208 1209 return; 1210} ## end sub rewrite_infinite 1211 1212=begin Implementation: 1213 1214Deleting nodes can change the equivalence classes (EC), so we need 1215multiple passes. In practice two passes should suffice in almost 1216all cases. 1217 1218Deleting nodes combines ECs; never splits them. You can prove this 1219by induction on the node levels, where a level 0 node has no children, 1220and a level n+1 node has children of level n or less. 1221 1222Level 0 nodes (always terminal and-nodes) will always have the same 1223signature regardless of node deletions. So if two level 0 nodes are in 1224the same EC before a set of deletions, they will be after. 1225 1226Induction hypothesis: any two nodes of level n in a common EC before a 1227set of deletions, will be in a common EC after the set of deletions. 1228 1229Two level n+1 or-nodes in the same EC: The EC's of their children must 1230have been the same. Since deletions are based on the EC of the children 1231on a per or-node basis, the same deletions will be made in both level n+1 1232or-nodes. And by the induction hypothesis, any node in an EC with one of 1233the children before the set of deletions, also shares and EC afterwards. 1234So the signature of the two level n+1 or-nodes will remain identical. 1235 1236Two level n+1 and-nodes: If either child is deleted, the level n+1 1237and-node is also deleted and becomes irrelevant. By the induction 1238hypothesis, and following the same argument as for level n+1 or-node 1239children, the signatures of the two level n+1 and-nodes will remain the 1240same, and they will remain together in an EC. 1241 1242=end Implementation: 1243 1244=cut 1245 1246# Negative so they cannot be the same as the ID of any 1247# actual child and-node or or-node. 1248use constant CHILD_IS_PRESENT => -2; 1249use constant CHILD_IS_ABSENT => -1; 1250 1251# Make sure and-nodes are unique. 1252sub delete_duplicate_nodes { 1253 1254 my ($evaler) = @_; 1255 1256 my $trace_evaluation = 1257 $evaler->[Marpa::Internal::Evaluator::TRACE_EVALUATION]; 1258 1259 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 1260 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 1261 1262 # Should the CAUSE_EARLEME be added to the base signature? 1263 1264 # The base signatures 1265 # never change except when an and-node is deleted. 1266 # In that case the base signature is never examined. 1267 # It becomes irrelevant, and the obsolete 1268 # entry is harmless. 1269 my @and_base_signatures; 1270 for my $and_node ( @{$and_nodes} ) { 1271 my $and_node_id = $and_node->[Marpa::Internal::Eval_And_Node::ID]; 1272 my $token_name = 1273 $and_node->[Marpa::Internal::Eval_And_Node::TOKEN_NAME]; 1274 $and_base_signatures[$and_node_id] = 1275 join q{,}, 1276 $and_node->[Marpa::Internal::Eval_And_Node::RULE_ID], 1277 $and_node->[Marpa::Internal::Eval_And_Node::POSITION], 1278 $and_node->[Marpa::Internal::Eval_And_Node::START_EARLEME], 1279 $and_node->[Marpa::Internal::Eval_And_Node::END_EARLEME], 1280 ( $token_name // q{} ); 1281 } ## end for my $and_node ( @{$and_nodes} ) 1282 1283 # As long as duplicates are found, we continue to loop 1284 DELETE_DUPLICATE_PASS: while (1) { 1285 1286 # We start with a first cut at the equivalence classes, 1287 # and refine. When we can't refine any more, we have 1288 # our equivalence classes 1289 1290 # Initially, lump everything into one huge proto-equivalence 1291 # class. 1292 my $and_class_by_signature = 1293 { INITIAL => Marpa::Internal::Evaluator::CHILD_IS_PRESENT }; 1294 my $or_class_by_signature = 1295 { INITIAL => Marpa::Internal::Evaluator::CHILD_IS_PRESENT }; 1296 my $and_node_ids_by_signature = { 1297 INITIAL => [ 1298 grep { 1299 not $and_nodes->[$_] 1300 ->[Marpa::Internal::Eval_And_Node::DELETED] 1301 } ( 0 .. $#{$and_nodes} ) 1302 ] 1303 }; 1304 my $or_node_ids_by_signature = { 1305 INITIAL => [ 1306 grep { 1307 not $or_nodes->[$_] 1308 ->[Marpa::Internal::Eval_Or_Node::DELETED] 1309 } ( 0 .. $#{$or_nodes} ) 1310 ] 1311 }; 1312 my $or_class_by_id = 1313 [ (Marpa::Internal::Evaluator::CHILD_IS_PRESENT) x 1314 scalar @{$or_nodes} ]; 1315 1316 REFINE_CLASSES_PASS: while (1) { 1317 1318 my $changed = 0; 1319 1320 my $new_and_class_by_signature = {}; 1321 my $new_or_class_by_signature = {}; 1322 my $new_and_node_ids_by_signature = {}; 1323 my $new_or_node_ids_by_signature = {}; 1324 1325 my $and_class_by_id = []; 1326 $#{$and_class_by_id} = $#{$and_nodes}; 1327 my $new_or_class_by_id = []; 1328 $#{$new_or_class_by_id} = $#{$or_nodes}; 1329 1330 AND_CLASS: 1331 while ( my ( $signature, $and_node_ids ) = 1332 each %{$and_node_ids_by_signature} ) 1333 { 1334 1335 for my $and_node_id ( @{$and_node_ids} ) { 1336 1337 # Deleted nodes should never make it in here 1338 my $new_signature = 1339 $and_base_signatures[$and_node_id] . q{;} 1340 . ( 1341 join q{,}, 1342 map { defined $_ ? $or_class_by_id->[$_] : -1 } 1343 @{ $and_nodes->[$and_node_id] }[ 1344 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 1345 Marpa::Internal::Eval_And_Node::CAUSE_ID 1346 ] 1347 ); 1348 $changed ||= $new_signature ne $signature; 1349 1350 my $new_class = 1351 $new_and_class_by_signature->{$new_signature}; 1352 if ( not defined $new_class ) { 1353 $new_class = 1354 $new_and_class_by_signature->{$new_signature} = 1355 $and_node_id; 1356 } 1357 $and_class_by_id->[$and_node_id] = $new_class; 1358 push 1359 @{ $new_and_node_ids_by_signature->{$new_signature} }, 1360 $and_node_id; 1361 1362 } ## end for my $and_node_id ( @{$and_node_ids} ) 1363 } ## end while ( my ( $signature, $and_node_ids ) = each %{...}) 1364 1365 OR_CLASS: 1366 while ( my ( $signature, $or_node_ids ) = 1367 each %{$or_node_ids_by_signature} ) 1368 { 1369 1370 for my $or_node_id ( @{$or_node_ids} ) { 1371 1372 # Deleted nodes should never make it in here 1373 my $new_signature = 1374 join q{,}, 1375 sort map { $and_class_by_id->[$_] } 1376 @{ $or_nodes->[$or_node_id] 1377 ->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] }; 1378 $changed ||= $new_signature ne $signature; 1379 1380 my $new_class = 1381 $new_or_class_by_signature->{$new_signature}; 1382 if ( not defined $new_class ) { 1383 $new_class = 1384 $new_or_class_by_signature->{$new_signature} = 1385 $or_node_id; 1386 } 1387 $new_or_class_by_id->[$or_node_id] = $new_class; 1388 push 1389 @{ $new_or_node_ids_by_signature->{$new_signature} }, 1390 $or_node_id; 1391 1392 } ## end for my $or_node_id ( @{$or_node_ids} ) 1393 } ## end while ( my ( $signature, $or_node_ids ) = each %{...}) 1394 1395 last REFINE_CLASSES_PASS if not $changed; 1396 1397 $and_class_by_signature = $new_and_class_by_signature; 1398 $or_class_by_signature = $new_or_class_by_signature; 1399 $and_node_ids_by_signature = $new_and_node_ids_by_signature; 1400 $or_node_ids_by_signature = $new_or_node_ids_by_signature; 1401 $or_class_by_id = $new_or_class_by_id; 1402 1403 } ## end while (1) 1404 1405 my @delete_work_list = (); 1406 AND_CLASS: 1407 while ( my ( $signature, $and_node_ids ) = 1408 each %{$and_node_ids_by_signature} ) 1409 { 1410 next AND_CLASS if scalar @{$and_node_ids} <= 1; 1411 1412 # We delete and-nodes in the same equivalence class 1413 # if they have the same parent 1414 my %parent; 1415 AND_NODE: for my $and_node_id ( @{$and_node_ids} ) { 1416 next AND_NODE 1417 if not $parent{ 1418 $and_nodes->[$and_node_id] 1419 ->[Marpa::Internal::Eval_And_Node::PARENT_ID] 1420 }++; 1421 1422 push @delete_work_list, [ 'a', $and_node_id ]; 1423 1424 next AND_NODE if not $trace_evaluation; 1425 1426 print {$Marpa::Internal::TRACE_FH} 1427 "Deleting duplicate and-node:\n", 1428 $and_nodes->[$and_node_id] 1429 ->[Marpa::Internal::Eval_And_Node::TAG], "\n" 1430 or Marpa::exception('print to trace handle failed'); 1431 1432 } ## end for my $and_node_id ( @{$and_node_ids} ) 1433 } ## end while ( my ( $signature, $and_node_ids ) = each %{...}) 1434 1435 # If no nodes are deleted, we are finished 1436 last DELETE_DUPLICATE_PASS 1437 if not scalar @delete_work_list 1438 or delete_nodes( $evaler, \@delete_work_list ) <= 0; 1439 1440 } ## end while (1) 1441 1442 return; 1443 1444} ## end sub delete_duplicate_nodes 1445 1446# Returns false if no parse 1447sub Marpa::Evaluator::new { 1448 my ( $class, @arg_hashes ) = @_; 1449 1450 ### Constructing new evaluator 1451 my $self = bless [], $class; 1452 1453 my $recce; 1454 my $parse_set_arg; 1455 1456 local $Marpa::Internal::EXPLICIT_CLOSURES = {}; 1457 1458 for my $arg_hash (@arg_hashes) { 1459 1460 my @recce_arg_values = 1461 grep {defined} @{$arg_hash}{qw(recognizer recce)}; 1462 if ( not defined $recce ) { 1463 Marpa::exception('recognizer specified more than once') 1464 if scalar @recce_arg_values > 1; 1465 $recce = shift @recce_arg_values; 1466 } 1467 else { 1468 Marpa::exception('recognizer specified more than once') 1469 if scalar @recce_arg_values; 1470 } 1471 delete @{$arg_hash}{qw(recognizer recce)}; 1472 1473 if ( defined $arg_hash->{end} ) { 1474 $parse_set_arg = $arg_hash->{end}; 1475 delete $arg_hash->{end}; 1476 } 1477 1478 if ( defined $arg_hash->{closures} ) { 1479 $Marpa::Internal::EXPLICIT_CLOSURES = $arg_hash->{closures}; 1480 delete $arg_hash->{closures}; 1481 } 1482 1483 } ## end for my $arg_hash (@arg_hashes) 1484 1485 Marpa::exception('No recognizer specified') if not defined $recce; 1486 my $recce_class = ref $recce; 1487 Marpa::exception( 1488 "${class}::new() recognizer arg has wrong class: $recce_class") 1489 if $recce_class ne 'Marpa::Recognizer'; 1490 1491 my $grammar = $recce->[Marpa::Internal::Recognizer::GRAMMAR]; 1492 $self->[Marpa::Internal::Evaluator::GRAMMAR] = $grammar; 1493 1494 local $Marpa::Internal::TRACE_FH = 1495 $self->[Marpa::Internal::Evaluator::TRACE_FILE_HANDLE] = 1496 $recce->[Marpa::Internal::Recognizer::TRACE_FILE_HANDLE]; 1497 1498 my $earley_sets = $recce->[Marpa::Internal::Recognizer::EARLEY_SETS]; 1499 my $earley_hash = $recce->[Marpa::Internal::Recognizer::EARLEY_HASH]; 1500 1501 Marpa::exception("Attempt to evaluate unfinished parse:\n") 1502 if not $recce->[Marpa::Internal::Recognizer::FINISHED]; 1503 1504 my $furthest_earleme = 1505 $recce->[Marpa::Internal::Recognizer::FURTHEST_EARLEME]; 1506 my $last_completed_earleme = 1507 $recce->[Marpa::Internal::Recognizer::LAST_COMPLETED_EARLEME]; 1508 Marpa::exception( 1509 "Attempt to evaluate incompletely recognized parse:\n", 1510 " Last token ends at location $furthest_earleme\n", 1511 " Recognition done only as far as location $last_completed_earleme\n" 1512 ) if $furthest_earleme > $last_completed_earleme; 1513 1514 # default settings 1515 $self->[Marpa::Internal::Evaluator::INFINITE_NODES] = 1000; 1516 $self->[Marpa::Internal::Evaluator::INFINITE_SCALE] = 2; 1517 $self->[Marpa::Internal::Evaluator::INFINITE_REWRITE] = 1; 1518 $self->[Marpa::Internal::Evaluator::MAX_PARSES] = -1; 1519 $self->[Marpa::Internal::Evaluator::PARSE_ORDER] = 'numeric'; 1520 $self->[Marpa::Internal::Evaluator::TRACE_VALUES] = 0; 1521 1522 $self->set(@arg_hashes); 1523 1524 my $rules = $grammar->[Marpa::Internal::Grammar::RULES]; 1525 my $symbols = $grammar->[Marpa::Internal::Grammar::SYMBOLS]; 1526 1527 my $parse_order = $self->[Marpa::Internal::Evaluator::PARSE_ORDER]; 1528 1529 my $trace_tasks = $self->[Marpa::Internal::Evaluator::TRACE_TASKS]; 1530 1531 $self->[Marpa::Internal::Evaluator::PARSE_COUNT] = 0; 1532 my $or_nodes = $self->[Marpa::Internal::Evaluator::OR_NODES] = []; 1533 my $and_nodes = $self->[Marpa::Internal::Evaluator::AND_NODES] = []; 1534 1535 my $current_parse_set = $parse_set_arg 1536 // $recce->[Marpa::Internal::Recognizer::FURTHEST_EARLEME]; 1537 1538 # Look for the start item and start rule 1539 my $earley_set = $earley_sets->[$current_parse_set]; 1540 1541 my $start_item; 1542 my $start_rule; 1543 my $start_state; 1544 1545 EARLEY_ITEM: for my $item ( @{$earley_set} ) { 1546 $start_state = $item->[Marpa::Internal::Earley_Item::STATE]; 1547 $start_rule = $start_state->[Marpa::Internal::AHFA::START_RULE]; 1548 next EARLEY_ITEM if not $start_rule; 1549 $start_item = $item; 1550 last EARLEY_ITEM; 1551 } ## end for my $item ( @{$earley_set} ) 1552 1553 return if not $start_rule; 1554 1555 my $start_rule_id = $start_rule->[Marpa::Internal::Rule::ID]; 1556 1557 local $Marpa::Internal::TRACE_ACTIONS = 1558 $self->[Marpa::Internal::Evaluator::TRACE_ACTIONS]; 1559 1560 my $null_values; 1561 $null_values = set_null_values($grammar); 1562 1563 # Set up rank closures by symbol 1564 my $ranking_closures_by_symbol = 1565 $self->[Marpa::Internal::Evaluator::RANKING_CLOSURES_BY_SYMBOL] = {}; 1566 SYMBOL: for my $symbol ( @{$symbols} ) { 1567 my $ranking_action = 1568 $symbol->[Marpa::Internal::Symbol::RANKING_ACTION]; 1569 next SYMBOL if not defined $ranking_action; 1570 my $ranking_closure = 1571 Marpa::Internal::Evaluator::resolve_semantics( $grammar, 1572 $ranking_action ); 1573 Marpa::exception("Ranking closure '$ranking_action' not found") 1574 if not defined $ranking_closure; 1575 $ranking_closures_by_symbol 1576 ->{ $symbol->[Marpa::Internal::Symbol::NAME] } = $ranking_closure; 1577 } ## end for my $symbol ( @{$symbols} ) 1578 1579 my $evaluator_rules = 1580 $self->[Marpa::Internal::Evaluator::RULE_VALUE_OPS] = 1581 set_actions($grammar); 1582 1583 # Get closure used in ranking, by rule 1584 my $ranking_closures_by_rule = 1585 $self->[Marpa::Internal::Evaluator::RANKING_CLOSURES_BY_RULE] = []; 1586 $#{$ranking_closures_by_rule} = $#{$rules}; 1587 RULE: for my $rule ( @{$rules} ) { 1588 next RULE 1589 if not my $ranking_action = 1590 $rule->[Marpa::Internal::Rule::RANKING_ACTION]; 1591 1592 # If the RHS is empty ... 1593 if ( not scalar @{ $rule->[Marpa::Internal::Rule::RHS] } ) { 1594 my $ranking_closure = 1595 Marpa::Internal::Evaluator::resolve_semantics( $grammar, 1596 $ranking_action ); 1597 Marpa::exception("Ranking closure '$ranking_action' not found") 1598 if not defined $ranking_closure; 1599 1600 $ranking_closures_by_symbol->{ $rule->[Marpa::Internal::Rule::LHS] 1601 ->[Marpa::Internal::Symbol::NULL_ALIAS] 1602 ->[Marpa::Internal::Symbol::NAME] } = $ranking_closure; 1603 } ## end if ( not scalar @{ $rule->[Marpa::Internal::Rule::RHS...]}) 1604 1605 next RULE if not $rule->[Marpa::Internal::Rule::USED]; 1606 my $ranking_closure = 1607 Marpa::Internal::Evaluator::resolve_semantics( $grammar, 1608 $ranking_action ); 1609 Marpa::exception("Ranking closure '$ranking_action' not found") 1610 if not defined $ranking_closure; 1611 $ranking_closures_by_rule->[ $rule->[Marpa::Internal::Rule::ID] ] = 1612 $ranking_closure; 1613 } ## end for my $rule ( @{$rules} ) 1614 1615 if (defined( 1616 my $action_object = 1617 $grammar->[Marpa::Internal::Grammar::ACTION_OBJECT] 1618 ) 1619 ) 1620 { 1621 my $constructor_name = $action_object . q{::new}; 1622 my $closure = resolve_semantics( $grammar, $constructor_name ); 1623 Marpa::exception(qq{Could not find constructor "$constructor_name"}) 1624 if not defined $closure; 1625 $self->[Marpa::Internal::Evaluator::ACTION_OBJECT_CONSTRUCTOR] = 1626 $closure; 1627 } ## end if ( defined( my $action_object = $grammar->[...])) 1628 1629 $self->[Marpa::Internal::Evaluator::SEMANTICS_SETTLED] = 1; 1630 1631 my @tree_rules; 1632 $#tree_rules = $#{$rules}; 1633 my @infinite_rule_ids = 1634 map { $_->[Marpa::Internal::Rule::ID] } 1635 @{ Marpa::Internal::Grammar::infinite_rules($grammar) }; 1636 @tree_rules[@infinite_rule_ids] = 1637 ( [Marpa::Internal::Evaluator_Op::CYCLE] ) x 1638 scalar @infinite_rule_ids; 1639 1640 my $start_symbol = $start_rule->[Marpa::Internal::Rule::LHS]; 1641 my ( $nulling, $symbol_id ) = 1642 @{$start_symbol}[ Marpa::Internal::Symbol::NULLING, 1643 Marpa::Internal::Symbol::ID, ]; 1644 my $start_null_value = $null_values->[$symbol_id]; 1645 1646 # deal with a null parse as a special case 1647 if ($nulling) { 1648 1649 my $or_node = []; 1650 $#{$or_node} = Marpa::Internal::Eval_Or_Node::LAST_FIELD; 1651 1652 my $and_node = []; 1653 $#{$and_node} = Marpa::Internal::Eval_And_Node::LAST_FIELD; 1654 1655 $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] = [0]; 1656 $or_node->[Marpa::Internal::Eval_Or_Node::START_EARLEME] = 0; 1657 $or_node->[Marpa::Internal::Eval_Or_Node::END_EARLEME] = 0; 1658 my $or_node_id = $or_node->[Marpa::Internal::Eval_Or_Node::ID] = 0; 1659 my $or_node_tag = $or_node->[Marpa::Internal::Eval_Or_Node::TAG] = 1660 $start_item->[Marpa::Internal::Earley_Item::NAME] 1661 . "o$or_node_id"; 1662 1663 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_REF] = 1664 \$start_null_value; 1665 $and_node->[Marpa::Internal::Eval_And_Node::TREE_OPS] = 1666 $tree_rules[$start_rule_id]; 1667 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_OPS] = 1668 $evaluator_rules->[$start_rule_id]; 1669 $and_node->[Marpa::Internal::Eval_And_Node::RULE_ID] = $start_rule_id; 1670 $and_node->[Marpa::Internal::Eval_And_Node::POSITION] = -1; 1671 $and_node->[Marpa::Internal::Eval_And_Node::START_EARLEME] = 0; 1672 $and_node->[Marpa::Internal::Eval_And_Node::END_EARLEME] = 0; 1673 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_EARLEME] = 0; 1674 $and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID] = 0; 1675 $and_node->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE] = 0; 1676 given ($parse_order) { 1677 when ('numeric') { 1678 $and_node 1679 ->[Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA] = 1680 0; 1681 $and_node->[Marpa::Internal::Eval_And_Node::RANKING_CLOSURE] = 1682 $ranking_closures_by_rule->[$start_rule_id]; 1683 } ## end when ('numeric') 1684 } ## end given 1685 my $and_node_id = $and_node->[Marpa::Internal::Eval_And_Node::ID] = 0; 1686 $and_node->[Marpa::Internal::Eval_And_Node::TAG] = 1687 $or_node_tag . "a$and_node_id"; 1688 1689 push @{$or_nodes}, $or_node; 1690 push @{$and_nodes}, $and_node; 1691 1692 return $self; 1693 1694 } # if $nulling 1695 1696 my @or_saplings; 1697 my %or_node_by_name; 1698 my $start_sapling = []; 1699 { 1700 my $start_name = $start_item->[Marpa::Internal::Earley_Item::NAME]; 1701 my $start_symbol_id = $start_symbol->[Marpa::Internal::Symbol::ID]; 1702 $start_name .= 'L' . $start_symbol_id; 1703 $start_sapling->[Marpa::Internal::Or_Sapling::NAME] = $start_name; 1704 } 1705 $start_sapling->[Marpa::Internal::Or_Sapling::ITEM] = $start_item; 1706 $start_sapling->[Marpa::Internal::Or_Sapling::CHILD_LHS_SYMBOL] = 1707 $start_symbol; 1708 push @or_saplings, $start_sapling; 1709 1710 OR_SAPLING: while ( my $or_sapling = pop @or_saplings ) { 1711 1712 my $sapling_name = $or_sapling->[Marpa::Internal::Or_Sapling::NAME]; 1713 my $item = $or_sapling->[Marpa::Internal::Or_Sapling::ITEM]; 1714 my $or_sapling_set = $item->[Marpa::Internal::Earley_Item::SET]; 1715 1716# Marpa::Display 1717# name: Leo Expansion 1718 1719 my $leo_links = $item->[Marpa::Internal::Earley_Item::LEO_LINKS] 1720 // []; 1721 1722 # If this is a Leo completion, translate the Leo links 1723 for my $leo_link ( @{$leo_links} ) { 1724 1725 my ( $leo_item, $cause, $token_name, $token_value ) = 1726 @{$leo_link}; 1727 my ( $next_leo_item, $leo_base_item ) = 1728 @{ $leo_item->[Marpa::Internal::Earley_Item::LINKS]->[0] }; 1729 1730 my $next_links = []; 1731 if ($token_name) { 1732 push @{$next_links}, 1733 [ $leo_base_item, undef, $token_name, $token_value ]; 1734 } 1735 if ($cause) { 1736 push @{$next_links}, [ $leo_base_item, $cause ]; 1737 } 1738 1739 LEO_ITEM: for ( ;; ) { 1740 1741 if ( not $next_leo_item ) { 1742 1743 push @{ $item->[Marpa::Internal::Earley_Item::LINKS] }, 1744 @{$next_links}; 1745 1746 # Now that the Leo links are translated, remove them 1747 $item->[Marpa::Internal::Earley_Item::LEO_LINKS] = undef; 1748 last LEO_ITEM; 1749 1750 } ## end if ( not $next_leo_item ) 1751 1752 my $state = $leo_item 1753 ->[Marpa::Internal::Earley_Item::LEO_ACTUAL_STATE]; 1754 my $origin = 1755 $next_leo_item->[Marpa::Internal::Earley_Item::SET]; 1756 my $name = sprintf 1757 'S%d@%d-%d', 1758 $state->[Marpa::Internal::AHFA::ID], 1759 $origin, 1760 $or_sapling_set; 1761 my $target_item = $earley_hash->{$name}; 1762 if ( not defined $target_item ) { 1763 $target_item = []; 1764 $target_item->[Marpa::Internal::Earley_Item::NAME] = 1765 $name; 1766 $target_item->[Marpa::Internal::Earley_Item::PARENT] = 1767 $origin; 1768 $target_item->[Marpa::Internal::Earley_Item::STATE] = 1769 $state; 1770 $target_item->[Marpa::Internal::Earley_Item::LINKS] = []; 1771 $target_item->[Marpa::Internal::Earley_Item::SET] = 1772 $or_sapling_set; 1773 $earley_hash->{$name} = $target_item; 1774 push @{ $earley_sets->[$or_sapling_set] }, $target_item; 1775 } ## end if ( not defined $target_item ) 1776 1777 push @{ $target_item->[Marpa::Internal::Earley_Item::LINKS] }, 1778 @{$next_links}; 1779 1780 $leo_item = $next_leo_item; 1781 1782 ( $next_leo_item, $leo_base_item ) = 1783 @{ $leo_item->[Marpa::Internal::Earley_Item::LINKS]->[0] 1784 }; 1785 1786 $next_links = [ [ $leo_base_item, $target_item ] ]; 1787 1788 } ## end for ( ;; ) 1789 } ## end for my $leo_link ( @{$leo_links} ) 1790 1791# Marpa::Display::End 1792 1793 my $child_lhs_symbol = 1794 $or_sapling->[Marpa::Internal::Or_Sapling::CHILD_LHS_SYMBOL]; 1795 my $rule = $or_sapling->[Marpa::Internal::Or_Sapling::RULE]; 1796 my $or_sapling_position = 1797 $or_sapling->[Marpa::Internal::Or_Sapling::POSITION]; 1798 1799 # If we don't have a current rule, we need to get one or 1800 # more rules, and deduce the position and a new symbol from 1801 # them. 1802 my @and_saplings; 1803 1804 if ( defined $or_sapling_position ) { 1805 1806 # Kernel or-node: We have a rule and a position. 1807 # get the current symbol 1808 1809 $or_sapling_position--; 1810 my $symbol = 1811 $rule->[Marpa::Internal::Rule::RHS]->[$or_sapling_position]; 1812 push @and_saplings, [ $rule, $or_sapling_position, $symbol ]; 1813 1814 } ## end if ( defined $or_sapling_position ) 1815 else { 1816 1817 # Closure or-node. 1818 1819 my $child_lhs_id = 1820 $child_lhs_symbol->[Marpa::Internal::Symbol::ID]; 1821 my $state = $item->[Marpa::Internal::Earley_Item::STATE]; 1822 for my $rule ( 1823 @{ $state->[Marpa::Internal::AHFA::COMPLETE_RULES] 1824 ->[$child_lhs_id]; 1825 } 1826 ) 1827 { 1828 1829 my $rhs = $rule->[Marpa::Internal::Rule::RHS]; 1830 1831 my $last_position = @{$rhs} - 1; 1832 push @and_saplings, 1833 [ 1834 $rule, 1835 $last_position, 1836 $rhs->[$last_position], 1837 $evaluator_rules->[ $rule->[Marpa::Internal::Rule::ID] ] 1838 ]; 1839 1840 } # for my $rule 1841 1842 } # closure or-node 1843 1844 my $start_earleme = $item->[Marpa::Internal::Earley_Item::PARENT]; 1845 my $end_earleme = $item->[Marpa::Internal::Earley_Item::SET]; 1846 1847 my @child_and_nodes; 1848 1849 my $item_name = $item->[Marpa::Internal::Earley_Item::NAME]; 1850 1851 for my $and_sapling (@and_saplings) { 1852 1853 my ( $and_sapling_rule, $and_sapling_position, $symbol, 1854 $value_processing ) 1855 = @{$and_sapling}; 1856 1857 my $rule_id = $and_sapling_rule->[Marpa::Internal::Rule::ID]; 1858 my $rhs = $and_sapling_rule->[Marpa::Internal::Rule::RHS]; 1859 my $rule_length = @{$rhs}; 1860 1861 my $or_bud_list; 1862 if ( $symbol->[Marpa::Internal::Symbol::NULLING] ) { 1863 my $nulling_symbol_id = 1864 $symbol->[Marpa::Internal::Symbol::ID]; 1865 my $nulling_symbol_name = 1866 $symbol->[Marpa::Internal::Symbol::NAME]; 1867 my $null_value = $null_values->[$nulling_symbol_id]; 1868 $or_bud_list = 1869 [ [ $item, undef, $nulling_symbol_name, \$null_value, ] ]; 1870 } ## end if ( $symbol->[Marpa::Internal::Symbol::NULLING] ) 1871 else { 1872 $or_bud_list = $item->[Marpa::Internal::Earley_Item::LINKS]; 1873 } 1874 1875 for my $or_bud ( @{$or_bud_list} ) { 1876 1877 my ( $predecessor, $cause, $token_name, $value_ref ) = 1878 @{$or_bud}; 1879 1880 my $predecessor_name; 1881 1882 if ( $and_sapling_position > 0 ) { 1883 1884 $predecessor_name = 1885 $predecessor->[Marpa::Internal::Earley_Item::NAME] 1886 . "R$rule_id:$and_sapling_position"; 1887 1888 # We check that the predecessor has not already been 1889 # processed so that cycles don't put us into a loop 1890 if ( not $predecessor_name ~~ %or_node_by_name ) { 1891 1892 $or_node_by_name{$predecessor_name} = []; 1893 1894 my $sapling = []; 1895 @{$sapling}[ 1896 Marpa::Internal::Or_Sapling::NAME, 1897 Marpa::Internal::Or_Sapling::RULE, 1898 Marpa::Internal::Or_Sapling::POSITION, 1899 Marpa::Internal::Or_Sapling::ITEM, 1900 ] 1901 = ( 1902 $predecessor_name, $and_sapling_rule, 1903 $and_sapling_position, $predecessor, 1904 ); 1905 1906 push @or_saplings, $sapling; 1907 1908 } # $predecessor_name ~~ %or_node_by_name 1909 1910 } # if and_sapling_position > 0 1911 1912 my $cause_name; 1913 1914 if ( defined $cause ) { 1915 1916 my $cause_symbol_id = 1917 $symbol->[Marpa::Internal::Symbol::ID]; 1918 1919 $cause_name = 1920 $cause->[Marpa::Internal::Earley_Item::NAME] . 'L' 1921 . $cause_symbol_id; 1922 1923 # We check that the cause has not already been 1924 # processed so that cycles don't put us into a loop 1925 if ( not $cause_name ~~ %or_node_by_name ) { 1926 1927 $or_node_by_name{$cause_name} = []; 1928 1929 my $sapling = []; 1930 @{$sapling}[ 1931 Marpa::Internal::Or_Sapling::NAME, 1932 Marpa::Internal::Or_Sapling::CHILD_LHS_SYMBOL, 1933 Marpa::Internal::Or_Sapling::ITEM, 1934 ] 1935 = ( $cause_name, $symbol, $cause, ); 1936 1937 push @or_saplings, $sapling; 1938 1939 } # $cause_name ~~ %or_node_by_name 1940 1941 } # if cause 1942 1943 my $and_node = []; 1944 $#{$and_node} = Marpa::Internal::Eval_And_Node::LAST_FIELD; 1945 1946 # At this point names stand in for the or-node ids, 1947 # which will eventually replace them in these fields 1948 $and_node->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID] = 1949 $predecessor_name; 1950 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID] = 1951 $cause_name; 1952 1953 $and_node->[Marpa::Internal::Eval_And_Node::TOKEN_NAME] = 1954 $token_name; 1955 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_REF] = 1956 $value_ref; 1957 $and_node->[Marpa::Internal::Eval_And_Node::RULE_ID] = 1958 $rule_id; 1959 1960 # Right now tree processing is only done on 1961 # closure and-nodes. 1962 if ( $and_sapling_position 1963 == $#{ $and_sapling_rule->[Marpa::Internal::Rule::RHS] } ) 1964 { 1965 $and_node->[Marpa::Internal::Eval_And_Node::TREE_OPS] = 1966 $tree_rules[$rule_id]; 1967 } ## end if ( $and_sapling_position == $#{ $and_sapling_rule...}) 1968 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_OPS] = 1969 $value_processing; 1970 given ($parse_order) { 1971 when ('numeric') { 1972 #<<< Cycles with perltidy as of 9 Aug 2010 1973 $and_node 1974 ->[Marpa::Internal::Eval_And_Node::RANKING_CLOSURE 1975 ] = $ranking_closures_by_rule->[$rule_id]; 1976 #<<<< 1977 $and_node->[ 1978 Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA 1979 ] = 1980 0 1981 } ## end when ('numeric') 1982 } ## end given 1983 1984 $and_node->[Marpa::Internal::Eval_And_Node::POSITION] = 1985 $and_sapling_position; 1986 $and_node->[Marpa::Internal::Eval_And_Node::START_EARLEME] = 1987 $start_earleme; 1988 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_EARLEME] = 1989 $predecessor 1990 ? $predecessor->[Marpa::Internal::Earley_Item::SET] 1991 : $start_earleme; 1992 $and_node->[Marpa::Internal::Eval_And_Node::END_EARLEME] = 1993 $end_earleme; 1994 my $id = $and_node->[Marpa::Internal::Eval_And_Node::ID] = 1995 @{$and_nodes}; 1996 Marpa::exception("Too many and-nodes for evaluator: $id") 1997 if $id & ~(Marpa::Internal::N_FORMAT_MAX); 1998 push @{$and_nodes}, $and_node; 1999 2000 push @child_and_nodes, $and_node; 2001 2002 } # for my $or_bud 2003 2004 } # for my $and_sapling 2005 2006 my $or_node = []; 2007 $#{$or_node} = Marpa::Internal::Eval_Or_Node::LAST_FIELD; 2008 my $or_node_id = $or_node->[Marpa::Internal::Eval_Or_Node::ID] = 2009 @{$or_nodes}; 2010 my $or_node_tag = $or_node->[Marpa::Internal::Eval_Or_Node::TAG] = 2011 $sapling_name . "o$or_node_id"; 2012 $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] = 2013 [ map { $_->[Marpa::Internal::Eval_And_Node::ID] } 2014 @child_and_nodes ]; 2015 for my $and_node_choice ( 0 .. $#child_and_nodes ) { 2016 my $and_node = $child_and_nodes[$and_node_choice]; 2017 my $and_node_id = $and_node->[Marpa::Internal::Eval_And_Node::ID]; 2018 $and_node->[Marpa::Internal::Eval_And_Node::TAG] = 2019 $or_node_tag . "a$and_node_id"; 2020 $and_node->[Marpa::Internal::Eval_And_Node::PARENT_ID] = 2021 $or_node_id; 2022 $and_node->[Marpa::Internal::Eval_And_Node::PARENT_CHOICE] = 2023 $and_node_choice; 2024 } ## end for my $and_node_choice ( 0 .. $#child_and_nodes ) 2025 $or_node->[Marpa::Internal::Eval_Or_Node::START_EARLEME] = 2026 $start_earleme; 2027 $or_node->[Marpa::Internal::Eval_Or_Node::END_EARLEME] = $end_earleme; 2028 $or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] = []; 2029 push @{$or_nodes}, $or_node; 2030 $or_node_by_name{$sapling_name} = $or_node; 2031 2032 } # OR_SAPLING 2033 2034 # resolve links in the bocage 2035 for my $and_node ( @{$and_nodes} ) { 2036 my $and_node_id = $and_node->[Marpa::Internal::Eval_And_Node::ID]; 2037 2038 FIELD: 2039 for my $field ( 2040 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 2041 Marpa::Internal::Eval_And_Node::CAUSE_ID, 2042 ) 2043 { 2044 my $name = $and_node->[$field]; 2045 next FIELD if not defined $name; 2046 my $child_or_node = $or_node_by_name{$name}; 2047 $and_node->[$field] = 2048 $child_or_node->[Marpa::Internal::Eval_Or_Node::ID]; 2049 my $parent_ids = 2050 $child_or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 2051 push @{$parent_ids}, $and_node_id; 2052 } ## end for my $field ( ...) 2053 2054 } ## end for my $and_node ( @{$and_nodes} ) 2055 2056 my $first_ambiguous_or_node = List::Util::first { 2057 @{ $_->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] } > 1; 2058 } 2059 @{$or_nodes}; 2060 2061 ### assert: Marpa'Evaluator'audit($self) or 1 2062 2063 if ( defined $first_ambiguous_or_node ) { 2064 delete_duplicate_nodes($self); 2065 } 2066 2067# perltidy has some problem with the spacing before this pod block 2068# Rather than fight the issue, I've commented the code out. 2069 2070# =pod 2071# 2072# =begin Implementation: 2073# 2074# We don't allow zero-length or-nodes to have more than one and-node parent. 2075# We do that to prevent two and-nodes in a parse from overlapping. For 2076# non-zero-length or-nodes preventing overlap is easy -- if no and-nodes 2077# have overlapping spans as determined by start and end earleme, they 2078# won't have overlapping non-zero-length or-nodes. But with zero-length 2079# or-nodes, an or-node can be a trailing or-node and a lead or-node at 2080# the same earleme location. That means that two adjacent and-nodes can 2081# share the same child or-node -- one which has it as a trailing or-node, 2082# the other which has it as a leading or-node. 2083# 2084# So in the below, we make sure every zero-length or-node has only one 2085# parent. 2086# 2087# I can assume no cycles. Reason: Marpa does not allow zero-length rules, 2088# and cycles in the bocage can only occur when rules derive rules. Breaking up 2089# rules into and-nodes with at most two children will not create cycles. 2090# It is impossible by breaking a rule up into pieces to make it cycle. 2091# Any predecessor chain of null symbols must lead back to the beginning 2092# of the rule, where it will end. 2093# 2094# =end Implementation: 2095# 2096# =cut 2097 2098 my @zero_width_work_list = grep { 2099 not $_->[Marpa::Internal::Eval_Or_Node::DELETED] 2100 and $_->[Marpa::Internal::Eval_Or_Node::START_EARLEME] 2101 == $_->[Marpa::Internal::Eval_Or_Node::END_EARLEME] 2102 } @{$or_nodes}; 2103 2104 OR_NODE: while ( my $or_node = pop @zero_width_work_list ) { 2105 2106 my $or_node_id = $or_node->[Marpa::Internal::Eval_Or_Node::ID]; 2107 2108 my $parent_and_node_ids = 2109 $or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS]; 2110 next OR_NODE if scalar @{$parent_and_node_ids} <= 1; 2111 2112 # Remove the other parents from the original (uncloned) 2113 # or-node. 2114 $or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] = 2115 [ $parent_and_node_ids->[0] ]; 2116 2117 my @child_and_nodes = 2118 map { $and_nodes->[$_] } 2119 @{ $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] }; 2120 2121 push @zero_width_work_list, map { $or_nodes->[$_] } 2122 grep {defined} 2123 map { 2124 @{$_}[ 2125 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 2126 Marpa::Internal::Eval_And_Node::CAUSE_ID 2127 ] 2128 } @child_and_nodes; 2129 2130 # This or-node needs to be cloned, so that it will be 2131 # unique to its parent and-node 2132 for my $parent_and_node_id ( 2133 @{$parent_and_node_ids}[ 1 .. $#{$parent_and_node_ids} ] ) 2134 { 2135 2136 my $cloned_or_node = []; 2137 $#{$cloned_or_node} = Marpa::Internal::Eval_Or_Node::LAST_FIELD; 2138 my $cloned_or_node_id = 2139 $cloned_or_node->[Marpa::Internal::Eval_Or_Node::ID] = 2140 @{$or_nodes}; 2141 for my $field ( 2142 Marpa::Internal::Eval_Or_Node::START_EARLEME, 2143 Marpa::Internal::Eval_Or_Node::END_EARLEME, 2144 Marpa::Internal::Eval_Or_Node::TAG 2145 ) 2146 { 2147 $cloned_or_node->[$field] = $or_node->[$field]; 2148 } ## end for my $field ( ...) 2149 $cloned_or_node->[Marpa::Internal::Eval_Or_Node::TAG] 2150 =~ s/ (o\d+) \z /o$cloned_or_node_id/xms; 2151 push @{$or_nodes}, $cloned_or_node; 2152 $cloned_or_node->[Marpa::Internal::Eval_Or_Node::PARENT_IDS] = 2153 [$parent_and_node_id]; 2154 $cloned_or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] = []; 2155 2156 for my $child_and_node (@child_and_nodes) { 2157 clone_and_node( $self, $child_and_node, $cloned_or_node_id ); 2158 } 2159 2160 my $parent_and_node = $and_nodes->[$parent_and_node_id]; 2161 FIELD: 2162 for my $field ( 2163 Marpa::Internal::Eval_And_Node::CAUSE_ID, 2164 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 2165 ) 2166 { 2167 my $sibling_id = $parent_and_node->[$field]; 2168 next FIELD if not defined $sibling_id; 2169 next FIELD if $sibling_id != $or_node_id; 2170 $parent_and_node->[$field] = $cloned_or_node_id; 2171 } ## end for my $field ( Marpa::Internal::Eval_And_Node::CAUSE_ID...) 2172 2173 } ## end for my $parent_and_node_id ( @{$parent_and_node_ids}[...]) 2174 2175 } ## end while ( my $or_node = pop @zero_width_work_list ) 2176 2177 ### assert: Marpa'Evaluator'audit($self) or 1 2178 2179 if ( $grammar->[Marpa::Internal::Grammar::IS_INFINITE] 2180 and $self->[Marpa::Internal::Evaluator::INFINITE_REWRITE] ) 2181 { 2182 rewrite_infinite( $self, \@infinite_rule_ids ); 2183 } 2184 2185 ### assert: Marpa'Evaluator'audit($self) or 1 2186 2187 return $self; 2188 2189} # sub new 2190 2191sub Marpa::dump_sort_key { 2192 my ($sort_key) = @_; 2193 my @element_dumps = (); 2194 for my $sort_element ( 2195 map { [ unpack 'N*', $_ ] } 2196 sort map { pack 'N*', @{$_} } @{$sort_key} 2197 ) 2198 { 2199 push @element_dumps, join q{ }, map { 2200 ( $_ & Marpa::Internal::N_FORMAT_HIGH_BIT ) 2201 ? ( q{~} . ~$_ ) 2202 : "$_" 2203 } @{$sort_element}; 2204 } ## end for my $sort_element ( map { [ unpack 'N*', $_ ] } sort...) 2205 return join q{ }, map { '<' . $_ . '>' } @element_dumps; 2206} ## end sub Marpa::dump_sort_key 2207 2208sub Marpa::Evaluator::show_sort_keys { 2209 my ($evaler) = @_; 2210 my $parse_order = $evaler->[Marpa::Internal::Evaluator::PARSE_ORDER]; 2211 Marpa::exception( 2212 "show_sort_keys called when parse order is not original\n", 2213 "parse order is $parse_order" ) 2214 if $parse_order ne 'original'; 2215 2216 my $or_iterations = $evaler->[Marpa::Internal::Evaluator::OR_ITERATIONS]; 2217 my $top_or_iteration = $or_iterations->[0]; 2218 Marpa::exception('show_sort_keys called on exhausted parse') 2219 if not $top_or_iteration; 2220 2221 my $text = q{}; 2222 for my $and_choice ( reverse @{$top_or_iteration} ) { 2223 my $sort_data = 2224 $and_choice->[Marpa::Internal::And_Choice::RANKING_DATA]; 2225 my $sort_key = 2226 $sort_data->[Marpa::Internal::Original_Sort_Data::SORT_KEY]; 2227 $text .= Marpa::dump_sort_key($sort_key) . "\n"; 2228 } ## end for my $and_choice ( reverse @{$top_or_iteration} ) 2229 return $text; 2230} ## end sub Marpa::Evaluator::show_sort_keys 2231 2232sub Marpa::Evaluator::show_and_node { 2233 my ( $evaler, $and_node, $verbose ) = @_; 2234 $verbose //= 0; 2235 2236 return q{} if $and_node->[Marpa::Internal::Eval_And_Node::DELETED]; 2237 2238 my $return_value = q{}; 2239 2240 my $grammar = $evaler->[Marpa::Internal::Evaluator::GRAMMAR]; 2241 my $rules = $grammar->[Marpa::Internal::Grammar::RULES]; 2242 2243 my $name = $and_node->[Marpa::Internal::Eval_And_Node::TAG]; 2244 my $predecessor_id = 2245 $and_node->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID]; 2246 my $cause_id = $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID]; 2247 my $value_ref = $and_node->[Marpa::Internal::Eval_And_Node::VALUE_REF]; 2248 my $rule_id = $and_node->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2249 my $position = $and_node->[Marpa::Internal::Eval_And_Node::POSITION]; 2250 2251 my @rhs = (); 2252 2253 my $rule = $rules->[$rule_id]; 2254 my $original_rule = $rule->[Marpa::Internal::Rule::ORIGINAL_RULE] 2255 // $rule; 2256 my $is_virtual_rule = $rule != $original_rule; 2257 2258 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 2259 2260 my $predecessor; 2261 if ($predecessor_id) { 2262 $predecessor = $or_nodes->[$predecessor_id]; 2263 push @rhs, $predecessor->[Marpa::Internal::Eval_Or_Node::TAG]; 2264 } # predecessor 2265 2266 my $cause; 2267 if ($cause_id) { 2268 $cause = $or_nodes->[$cause_id]; 2269 push @rhs, $cause->[Marpa::Internal::Eval_Or_Node::TAG]; 2270 } # cause 2271 2272 if ( defined $value_ref ) { 2273 my $value_as_string = 2274 Data::Dumper->new( [$value_ref] )->Terse(1)->Dump; 2275 chomp $value_as_string; 2276 push @rhs, $value_as_string; 2277 } # value 2278 2279 $return_value .= "$name -> " . join( q{ }, @rhs ) . "\n"; 2280 2281 SHOW_RULE: { 2282 if ( $is_virtual_rule and $verbose >= 2 ) { 2283 $return_value 2284 .= ' rule ' 2285 . $rule->[Marpa::Internal::Rule::ID] . ': ' 2286 . Marpa::show_dotted_rule( $rule, $position + 1 ) 2287 . "\n " 2288 . Marpa::brief_virtual_rule( $rule, $position + 1 ) . "\n"; 2289 last SHOW_RULE; 2290 } ## end if ( $is_virtual_rule and $verbose >= 2 ) 2291 2292 last SHOW_RULE if not $verbose; 2293 $return_value 2294 .= ' rule ' 2295 . $rule->[Marpa::Internal::Rule::ID] . ': ' 2296 . Marpa::brief_virtual_rule( $rule, $position + 1 ) . "\n"; 2297 2298 } ## end SHOW_RULE: 2299 2300 if ( $verbose >= 2 ) { 2301 my @comment = (); 2302 if ( $and_node->[Marpa::Internal::Eval_And_Node::TREE_OPS] ) { 2303 push @comment, 'tree_ops'; 2304 } 2305 if ( $and_node->[Marpa::Internal::Eval_And_Node::VALUE_OPS] ) { 2306 push @comment, 'value_ops'; 2307 } 2308 if ( scalar @comment ) { 2309 $return_value .= q{ } . ( join q{, }, @comment ) . "\n"; 2310 } 2311 } ## end if ( $verbose >= 2 ) 2312 2313 return $return_value; 2314 2315} ## end sub Marpa::Evaluator::show_and_node 2316 2317sub Marpa::Evaluator::show_or_node { 2318 my ( $evaler, $or_node, $verbose, ) = @_; 2319 $verbose //= 0; 2320 2321 return q{} if $or_node->[Marpa::Internal::Eval_Or_Node::DELETED]; 2322 2323 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 2324 2325 my $text = q{}; 2326 2327 my $or_node_tag = $or_node->[Marpa::Internal::Eval_Or_Node::TAG]; 2328 my $and_node_ids = $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 2329 2330 for my $index ( 0 .. $#{$and_node_ids} ) { 2331 my $and_node_id = $and_node_ids->[$index]; 2332 my $and_node = $and_nodes->[$and_node_id]; 2333 2334 my $and_node_tag = $or_node_tag . "a$and_node_id"; 2335 if ( $verbose >= 2 ) { 2336 $text .= "$or_node_tag -> $and_node_tag\n"; 2337 } 2338 2339 $text .= $evaler->show_and_node( $and_node, $verbose ); 2340 2341 } ## end for my $index ( 0 .. $#{$and_node_ids} ) 2342 2343 return $text; 2344 2345} ## end sub Marpa::Evaluator::show_or_node 2346 2347sub Marpa::Evaluator::show_bocage { 2348 my ( $evaler, $verbose, ) = @_; 2349 $verbose //= 0; 2350 2351 my $parse_count = $evaler->[Marpa::Internal::Evaluator::PARSE_COUNT]; 2352 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 2353 2354 my $text = 'parse count: ' . $parse_count . "\n"; 2355 2356 for my $or_node ( @{$or_nodes} ) { 2357 2358 $text 2359 .= Marpa::Evaluator::show_or_node( $evaler, $or_node, $verbose ); 2360 2361 } ## end for my $or_node ( @{$or_nodes} ) 2362 2363 return $text; 2364} ## end sub Marpa::Evaluator::show_bocage 2365 2366# This routine is undocumented, pending a design review. 2367sub Marpa::Evaluator::show_ambiguity { 2368 my ( $evaler, $verbose, ) = @_; 2369 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 2370 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 2371 my $grammar = $evaler->[Marpa::Internal::Evaluator::GRAMMAR]; 2372 my $AHFA = $grammar->[Marpa::Internal::Grammar::AHFA]; 2373 $verbose //= 0; 2374 my $text = q{}; 2375 2376 OR_NODE: 2377 for my $or_node ( @{$or_nodes} ) { 2378 my $child_ids = $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS]; 2379 my $child_count = scalar @{$child_ids}; 2380 next OR_NODE if $child_count <= 1; 2381 my $or_tag = $or_node->[Marpa::Internal::Eval_Or_Node::TAG]; 2382 $text .= "$or_tag is Ambiguous: $child_count children\n"; 2383 for my $child_ix ( 0 .. $#{$child_ids} ) { 2384 my $child_and_node_id = $child_ids->[$child_ix]; 2385 my $and_node = $and_nodes->[$child_and_node_id]; 2386 my $and_tag = $and_node->[Marpa::Internal::Eval_And_Node::TAG]; 2387 $text .= " choice #$child_ix: $and_tag ::="; 2388 my $detail_text = q{}; 2389 if (defined( 2390 my $predecessor_id = 2391 $and_node 2392 ->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID] 2393 ) 2394 ) 2395 { 2396 my $or_grandchild = $or_nodes->[$predecessor_id]; 2397 my $grandchild_tag = 2398 $or_grandchild->[Marpa::Internal::Eval_Or_Node::TAG]; 2399 my ($state) = ( $grandchild_tag =~ /\A S (\d+) [@]/xms ); 2400 $text .= " $grandchild_tag"; 2401 $detail_text 2402 .= Marpa::show_AHFA_state( $AHFA->[ $state + 0 ], 0 ); 2403 } ## end if ( defined( my $predecessor_id = $and_node->[...])) 2404 if (defined( 2405 my $cause_id = 2406 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID] 2407 ) 2408 ) 2409 { 2410 my $or_grandchild = $or_nodes->[$cause_id]; 2411 my $grandchild_tag = 2412 $or_grandchild->[Marpa::Internal::Eval_Or_Node::TAG]; 2413 my ($state) = ( $grandchild_tag =~ /\A S (\d+) [@]/xms ); 2414 $text .= " $grandchild_tag"; 2415 $detail_text 2416 .= Marpa::show_AHFA_state( $AHFA->[ $state + 0 ], 0 ); 2417 } ## end if ( defined( my $cause_id = $and_node->[...])) 2418 if (defined( 2419 my $value_ref = 2420 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_REF] 2421 ) 2422 ) 2423 { 2424 $text .= ' Token'; 2425 $detail_text 2426 .= Data::Dumper->new($value_ref)->Terse(1)->Dump(); 2427 } ## end if ( defined( my $value_ref = $and_node->[...])) 2428 $detail_text =~ s/^/ /gxms; 2429 $text .= "\n$detail_text"; 2430 } ## end for my $child_ix ( 0 .. $#{$child_ids} ) 2431 } ## end for my $or_node ( @{$or_nodes} ) 2432 2433 return $text; 2434} ## end sub Marpa::Evaluator::show_ambiguity 2435 2436use constant EVALUATOR_OPTIONS => [ 2437 qw{ 2438 infinite_nodes 2439 infinite_rewrite 2440 infinite_scale 2441 experimental 2442 max_parses 2443 parse_order 2444 trace_actions 2445 trace_evaluation 2446 trace_file_handle 2447 trace_tasks 2448 trace_values 2449 } 2450]; 2451 2452sub Marpa::Evaluator::set { 2453 my ( $evaler, @arg_hashes ) = @_; 2454 local $Marpa::Internal::TRACE_FH = 2455 $evaler->[Marpa::Internal::Evaluator::TRACE_FILE_HANDLE]; 2456 2457 for my $args (@arg_hashes) { 2458 2459 my $ref_type = ref $args; 2460 if ( not $ref_type or $ref_type ne 'HASH' ) { 2461 Marpa::exception( 2462 'Marpa expects args as ref to HASH, got ', 2463 ( "ref to $ref_type" || 'non-reference' ), 2464 ' instead' 2465 ); 2466 } ## end if ( not $ref_type or $ref_type ne 'HASH' ) 2467 if (my @bad_options = 2468 grep { not $_ ~~ Marpa::Internal::Evaluator::EVALUATOR_OPTIONS } 2469 keys %{$args} 2470 ) 2471 { 2472 Marpa::exception( 'Unknown option(s) for Marpa Evaluator: ', 2473 join q{ }, @bad_options ); 2474 } ## end if ( my @bad_options = grep { not $_ ~~ ...}) 2475 2476 if ( defined( my $value = $args->{'trace_file_handle'} ) ) { 2477 $evaler->[Marpa::Internal::Evaluator::TRACE_FILE_HANDLE] = $value; 2478 } 2479 2480 if ( defined( my $value = $args->{'trace_actions'} ) ) { 2481 $evaler->[Marpa::Internal::Evaluator::TRACE_ACTIONS] = $value; 2482 if ($value) { 2483 say {$Marpa::Internal::TRACE_FH} 2484 'Setting trace_actions option' 2485 or Marpa::exception("Cannot print: $ERRNO"); 2486 if ($evaler->[Marpa::Internal::Evaluator::SEMANTICS_SETTLED] ) 2487 { 2488 say {$Marpa::Internal::TRACE_FH} 2489 'Warning: setting trace_actions option after semantics were finalized' 2490 or Marpa::exception("Cannot print: $ERRNO"); 2491 } ## end if ( $evaler->[...]) 2492 $evaler->[Marpa::Internal::Evaluator::TRACING] = 1; 2493 } ## end if ($value) 2494 } ## end if ( defined( my $value = $args->{'trace_actions'} )) 2495 2496 # TO HERE 2497 2498 if ( defined( my $value = $args->{'trace_values'} ) ) { 2499 Marpa::exception('trace_values must be set to a number >= 0') 2500 if not $value =~ /\A\d+\z/xms; 2501 $evaler->[Marpa::Internal::Evaluator::TRACE_VALUES] = $value + 0; 2502 if ($value) { 2503 say {$Marpa::Internal::TRACE_FH} 2504 "Setting trace_values option to $value" 2505 or Marpa::exception("Cannot print: $ERRNO"); 2506 $evaler->[Marpa::Internal::Evaluator::TRACING] = 1; 2507 } ## end if ($value) 2508 } ## end if ( defined( my $value = $args->{'trace_values'} ) ) 2509 2510 if ( defined( my $value = $args->{'trace_tasks'} ) ) { 2511 Marpa::exception('trace_tasks must be set to a number >= 0') 2512 if $value !~ /\A\d+\z/xms; 2513 $evaler->[Marpa::Internal::Evaluator::TRACE_TASKS] = $value + 0; 2514 if ($value) { 2515 say {$Marpa::Internal::TRACE_FH} 2516 "Setting trace_tasks option to $value" 2517 or Marpa::exception("Cannot print: $ERRNO"); 2518 $evaler->[Marpa::Internal::Evaluator::TRACING] = 1; 2519 } ## end if ($value) 2520 } ## end if ( defined( my $value = $args->{'trace_tasks'} ) ) 2521 2522 if ( defined( my $value = $args->{'trace_evaluation'} ) ) { 2523 Marpa::exception('trace_evaluation must be set to a number >= 0') 2524 if $value !~ /\A\d+\z/xms; 2525 $evaler->[Marpa::Internal::Evaluator::TRACE_EVALUATION] = 2526 $value + 0; 2527 if ($value) { 2528 say {$Marpa::Internal::TRACE_FH} 2529 "Setting trace_evaluation option to $value" 2530 or Marpa::exception("Cannot print: $ERRNO"); 2531 $evaler->[Marpa::Internal::Evaluator::TRACING] = 1; 2532 } ## end if ($value) 2533 } ## end if ( defined( my $value = $args->{'trace_evaluation'...})) 2534 2535 if ( defined( my $value = $args->{'infinite_scale'} ) ) { 2536 Marpa::exception( 2537 'infinite_scale option only allowed in experimental mode') 2538 if not $evaler->[Marpa::Internal::Evaluator::EXPERIMENTAL]; 2539 Marpa::exception(q{infinite_scale must be >1}) 2540 if $value <= 1; 2541 no integer; 2542 $evaler->[Marpa::Internal::Evaluator::INFINITE_SCALE] = 2543 POSIX::ceil($value); 2544 use integer; 2545 } ## end if ( defined( my $value = $args->{'infinite_scale'} ...)) 2546 2547 if ( defined( my $value = $args->{'infinite_nodes'} ) ) { 2548 Marpa::exception( 2549 'infinite_nodes option only allowed in experimental mode') 2550 if $evaler->[Marpa::Internal::Evaluator::EXPERIMENTAL] <= 0; 2551 Marpa::exception(q{infinite_nodes must be >0}) 2552 if $value <= 0; 2553 $evaler->[Marpa::Internal::Evaluator::INFINITE_NODES] = $value; 2554 } ## end if ( defined( my $value = $args->{'infinite_nodes'} ...)) 2555 2556 if ( defined( my $value = $args->{'infinite_rewrite'} ) ) { 2557 $evaler->[Marpa::Internal::Evaluator::INFINITE_REWRITE] = $value; 2558 } 2559 2560 if ( defined( my $value = $args->{'max_parses'} ) ) { 2561 $evaler->[Marpa::Internal::Evaluator::MAX_PARSES] = $value; 2562 } 2563 2564 if ( defined( my $value = $args->{'experimental'} ) ) { 2565 given ($value) { 2566 when (undef) { $value = 0 } 2567 when ('no warning') { 2568 $value = 1 2569 } 2570 default { 2571 say { 2572 $Marpa::Internal::TRACE_FH 2573 } 2574 'Experimental (in other words, buggy) features enabled' 2575 or Marpa::exception("Cannot print: $ERRNO"); 2576 $value = 1; 2577 } ## end default 2578 } ## end given 2579 $evaler->[Marpa::Internal::Evaluator::EXPERIMENTAL] = $value; 2580 } ## end if ( defined( my $value = $args->{'experimental'} ) ) 2581 2582 if ( defined( my $value = $args->{'parse_order'} ) ) { 2583 Marpa::exception(q{parse_order must be 'numeric' or 'none'}) 2584 if not $value ~~ [qw(original numeric none)]; 2585 $evaler->[Marpa::Internal::Evaluator::PARSE_ORDER] = $value; 2586 } 2587 2588 } ## end for my $args (@arg_hashes) 2589 2590 return 1; 2591} ## end sub Marpa::Evaluator::set 2592 2593use Marpa::Offset qw( 2594 { tasks for use in Marpa::Evaluator::value } 2595 :package=Marpa::Internal::Task 2596 RESET_AND_NODE 2597 SETUP_AND_NODE 2598 NEXT_AND_TREE 2599 ITERATE_AND_TREE 2600 ITERATE_AND_TREE_2 2601 ITERATE_AND_TREE_3 2602 RESET_AND_TREE 2603 RESET_OR_NODE 2604 RESET_OR_TREE 2605 ITERATE_OR_NODE 2606 ITERATE_OR_TREE 2607 FREEZE_TREE 2608 THAW_TREE 2609 EVALUATE 2610); 2611 2612# Does not modify stack 2613sub evaluate { 2614 my ( $grammar, $action_object, $stack, $trace_values ) = @_; 2615 2616 $trace_values //= 0; 2617 my $rules = $grammar->[Marpa::Internal::Grammar::RULES]; 2618 2619 my @evaluation_stack = (); 2620 my @virtual_rule_stack = (); 2621 TREE_NODE: for my $and_node ( reverse @{$stack} ) { 2622 2623 if ( $trace_values >= 3 ) { 2624 for my $i ( reverse 0 .. $#evaluation_stack ) { 2625 printf {$Marpa::Internal::TRACE_FH} 'Stack position %3d:', $i 2626 or Marpa::exception('print to trace handle failed'); 2627 print {$Marpa::Internal::TRACE_FH} q{ }, 2628 Data::Dumper->new( [ $evaluation_stack[$i] ] )->Terse(1) 2629 ->Dump 2630 or Marpa::exception('print to trace handle failed'); 2631 } ## end for my $i ( reverse 0 .. $#evaluation_stack ) 2632 } ## end if ( $trace_values >= 3 ) 2633 2634 my $value_ref = 2635 $and_node->[Marpa::Internal::Eval_And_Node::VALUE_REF]; 2636 2637 if ( defined $value_ref ) { 2638 2639 push @evaluation_stack, $value_ref; 2640 2641 if ($trace_values) { 2642 my $token_name = 2643 $and_node->[Marpa::Internal::Eval_And_Node::TOKEN_NAME]; 2644 print {$Marpa::Internal::TRACE_FH} 2645 'Pushed value from a', 2646 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2647 q{ }, 2648 $and_node->[Marpa::Internal::Eval_And_Node::TAG], ': ', 2649 ( $token_name ? qq{$token_name = } : q{} ), 2650 Data::Dumper->new( [$value_ref] )->Terse(1)->Dump 2651 or Marpa::exception('print to trace handle failed'); 2652 } ## end if ($trace_values) 2653 2654 } # defined $value_ref 2655 2656 my $ops = $and_node->[Marpa::Internal::Eval_And_Node::VALUE_OPS]; 2657 2658 next TREE_NODE if not defined $ops; 2659 2660 my $current_data = []; 2661 my $op_ix = 0; 2662 while ( $op_ix < scalar @{$ops} ) { 2663 given ( $ops->[ $op_ix++ ] ) { 2664 2665 when (Marpa::Internal::Evaluator_Op::ARGC) { 2666 2667 my $argc = $ops->[ $op_ix++ ]; 2668 2669 if ($trace_values) { 2670 my $rule_id = $and_node 2671 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2672 my $rule = $rules->[$rule_id]; 2673 say {$Marpa::Internal::TRACE_FH} 2674 'Popping ', 2675 $argc, 2676 ' values to evaluate a', 2677 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2678 q{ }, 2679 $and_node->[Marpa::Internal::Eval_And_Node::TAG], 2680 ', rule: ', Marpa::brief_rule($rule) 2681 or 2682 Marpa::exception('Could not print to trace file'); 2683 } ## end if ($trace_values) 2684 2685 $current_data = 2686 [ map { ${$_} } 2687 ( splice @evaluation_stack, -$argc ) ]; 2688 2689 } ## end when (Marpa::Internal::Evaluator_Op::ARGC) 2690 2691 when (Marpa::Internal::Evaluator_Op::VIRTUAL_HEAD) { 2692 my $real_symbol_count = $ops->[ $op_ix++ ]; 2693 2694 if ($trace_values) { 2695 my $rule_id = $and_node 2696 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2697 my $rule = $rules->[$rule_id]; 2698 say {$Marpa::Internal::TRACE_FH} 2699 'Head of Virtual Rule: a', 2700 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2701 q{ }, 2702 $and_node->[Marpa::Internal::Eval_And_Node::TAG], 2703 ', rule: ', Marpa::brief_rule($rule), 2704 "\n", 2705 "Incrementing virtual rule by $real_symbol_count symbols\n", 2706 'Currently ', 2707 ( scalar @virtual_rule_stack ), 2708 ' rules; ', $virtual_rule_stack[-1], ' symbols;', 2709 or 2710 Marpa::exception('Could not print to trace file'); 2711 } ## end if ($trace_values) 2712 2713 $real_symbol_count += pop @virtual_rule_stack; 2714 $current_data = 2715 [ map { ${$_} } 2716 ( splice @evaluation_stack, -$real_symbol_count ) 2717 ]; 2718 2719 } ## end when (Marpa::Internal::Evaluator_Op::VIRTUAL_HEAD) 2720 2721 when (Marpa::Internal::Evaluator_Op::VIRTUAL_HEAD_NO_SEP) { 2722 my $real_symbol_count = $ops->[ $op_ix++ ]; 2723 2724 if ($trace_values) { 2725 my $rule_id = $and_node 2726 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2727 my $rule = $rules->[$rule_id]; 2728 say {$Marpa::Internal::TRACE_FH} 2729 'Head of Virtual Rule (discards separation): a', 2730 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2731 q{ }, 2732 $and_node->[Marpa::Internal::Eval_And_Node::TAG], 2733 ', rule: ', Marpa::brief_rule($rule), 2734 "\nAdding $real_symbol_count symbols; currently ", 2735 ( scalar @virtual_rule_stack ), 2736 ' rules; ', $virtual_rule_stack[-1], ' symbols' 2737 or 2738 Marpa::exception('Could not print to trace file'); 2739 } ## end if ($trace_values) 2740 2741 $real_symbol_count += pop @virtual_rule_stack; 2742 my $base = 2743 ( scalar @evaluation_stack ) - $real_symbol_count; 2744 $current_data = [ 2745 map { ${$_} } @evaluation_stack[ 2746 map { $base + 2 * $_ } 2747 ( 0 .. ( $real_symbol_count + 1 ) / 2 - 1 ) 2748 ] 2749 ]; 2750 2751 # truncate the evaluation stack 2752 $#evaluation_stack = $base - 1; 2753 2754 } ## end when (...) 2755 2756 when (Marpa::Internal::Evaluator_Op::VIRTUAL_KERNEL) { 2757 my $real_symbol_count = $ops->[ $op_ix++ ]; 2758 $virtual_rule_stack[-1] += $real_symbol_count; 2759 2760 if ($trace_values) { 2761 my $rule_id = $and_node 2762 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2763 my $rule = $rules->[$rule_id]; 2764 say {$Marpa::Internal::TRACE_FH} 2765 'Virtual Rule: a', 2766 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2767 q{ }, 2768 $and_node->[Marpa::Internal::Eval_And_Node::TAG], 2769 ', rule: ', Marpa::brief_rule($rule), 2770 "\nAdding $real_symbol_count, now ", 2771 ( scalar @virtual_rule_stack ), 2772 ' rules; ', $virtual_rule_stack[-1], ' symbols' 2773 or 2774 Marpa::exception('Could not print to trace file'); 2775 } ## end if ($trace_values) 2776 2777 } ## end when (Marpa::Internal::Evaluator_Op::VIRTUAL_KERNEL) 2778 2779 when (Marpa::Internal::Evaluator_Op::VIRTUAL_TAIL) { 2780 my $real_symbol_count = $ops->[ $op_ix++ ]; 2781 2782 if ($trace_values) { 2783 my $rule_id = $and_node 2784 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2785 my $rule = $rules->[$rule_id]; 2786 say {$Marpa::Internal::TRACE_FH} 2787 'New Virtual Rule: a', 2788 $and_node->[Marpa::Internal::Eval_And_Node::ID], 2789 q{ }, 2790 $and_node->[Marpa::Internal::Eval_And_Node::TAG], 2791 ', rule: ', Marpa::brief_rule($rule), 2792 "\nSymbol count is $real_symbol_count, now ", 2793 ( scalar @virtual_rule_stack + 1 ), ' rules', 2794 or 2795 Marpa::exception('Could not print to trace file'); 2796 } ## end if ($trace_values) 2797 2798 push @virtual_rule_stack, $real_symbol_count; 2799 2800 } ## end when (Marpa::Internal::Evaluator_Op::VIRTUAL_TAIL) 2801 2802 when (Marpa::Internal::Evaluator_Op::CONSTANT_RESULT) { 2803 my $result = $ops->[ $op_ix++ ]; 2804 if ($trace_values) { 2805 print {$Marpa::Internal::TRACE_FH} 2806 'Constant result: ', 2807 'Pushing 1 value on stack: ', 2808 Data::Dumper->new( [$result] )->Terse(1)->Dump 2809 or 2810 Marpa::exception('Could not print to trace file'); 2811 } ## end if ($trace_values) 2812 push @evaluation_stack, $result; 2813 } ## end when (Marpa::Internal::Evaluator_Op::CONSTANT_RESULT) 2814 2815 when (Marpa::Internal::Evaluator_Op::CALL) { 2816 my $closure = $ops->[ $op_ix++ ]; 2817 my $result; 2818 2819 my @warnings; 2820 my $eval_ok; 2821 DO_EVAL: { 2822 local $SIG{__WARN__} = sub { 2823 push @warnings, [ $_[0], ( caller 0 ) ]; 2824 }; 2825 2826 $eval_ok = eval { 2827 $result = 2828 $closure->( $action_object, 2829 @{$current_data} ); 2830 1; 2831 }; 2832 2833 } ## end DO_EVAL: 2834 2835 if ( not $eval_ok or @warnings ) { 2836 my $rule_id = $and_node 2837 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2838 my $rule = $rules->[$rule_id]; 2839 my $fatal_error = $EVAL_ERROR; 2840 Marpa::Internal::code_problems( 2841 { fatal_error => $fatal_error, 2842 grammar => $grammar, 2843 eval_ok => $eval_ok, 2844 warnings => \@warnings, 2845 where => 'computing value', 2846 long_where => 'Computing value for rule: ' 2847 . Marpa::brief_rule($rule), 2848 } 2849 ); 2850 } ## end if ( not $eval_ok or @warnings ) 2851 2852 if ($trace_values) { 2853 print {$Marpa::Internal::TRACE_FH} 2854 'Calculated and pushed value: ', 2855 Data::Dumper->new( [$result] )->Terse(1)->Dump 2856 or 2857 Marpa::exception('print to trace handle failed'); 2858 } ## end if ($trace_values) 2859 2860 push @evaluation_stack, \$result; 2861 2862 } ## end when (Marpa::Internal::Evaluator_Op::CALL) 2863 2864 default { 2865 Marpa::Exception("Unknown evaluator Op: $_"); 2866 } 2867 2868 } ## end given 2869 } ## end while ( $op_ix < scalar @{$ops} ) 2870 2871 } # TREE_NODE 2872 2873 return pop @evaluation_stack; 2874} ## end sub evaluate 2875 2876sub Marpa::Evaluator::value { 2877 my ($evaler) = @_; 2878 2879 Marpa::exception('No parse supplied') if not defined $evaler; 2880 my $evaler_class = ref $evaler; 2881 my $right_class = 'Marpa::Evaluator'; 2882 Marpa::exception( 2883 "Don't parse argument is class: $evaler_class; should be: $right_class" 2884 ) if $evaler_class ne $right_class; 2885 2886 local $Marpa::Internal::TRACE_FH = 2887 $evaler->[Marpa::Internal::Evaluator::TRACE_FILE_HANDLE]; 2888 2889 my $grammar = $evaler->[Marpa::Internal::Evaluator::GRAMMAR]; 2890 my $rules = $grammar->[Marpa::Internal::Grammar::RULES]; 2891 my $symbol_hash = $grammar->[Marpa::Internal::Grammar::SYMBOL_HASH]; 2892 my $symbols = $grammar->[Marpa::Internal::Grammar::SYMBOLS]; 2893 2894 my $parse_order = $evaler->[Marpa::Internal::Evaluator::PARSE_ORDER]; 2895 2896 my $parse_count = $evaler->[Marpa::Internal::Evaluator::PARSE_COUNT]++; 2897 2898 my $evaluator_rules = 2899 $evaler->[Marpa::Internal::Evaluator::RULE_VALUE_OPS]; 2900 my $and_nodes = $evaler->[Marpa::Internal::Evaluator::AND_NODES]; 2901 my $or_nodes = $evaler->[Marpa::Internal::Evaluator::OR_NODES]; 2902 my $ranking_closures_by_symbol = 2903 $evaler->[Marpa::Internal::Evaluator::RANKING_CLOSURES_BY_SYMBOL]; 2904 2905 # If the arrays of iteration data 2906 # for the and-nodes and or-nodes are undefined, 2907 # this is the first pass through, and there is some 2908 # initialization that needs to be done. 2909 my $and_iterations = 2910 $evaler->[Marpa::Internal::Evaluator::AND_ITERATIONS]; 2911 my $or_iterations = $evaler->[Marpa::Internal::Evaluator::OR_ITERATIONS]; 2912 SET_UP_ITERATIONS: { 2913 last SET_UP_ITERATIONS if defined $and_iterations; 2914 2915 $#{$and_iterations} = $#{$and_nodes}; 2916 $#{$or_iterations} = $#{$or_nodes}; 2917 $evaler->[Marpa::Internal::Evaluator::AND_ITERATIONS] = 2918 $and_iterations; 2919 $evaler->[Marpa::Internal::Evaluator::OR_ITERATIONS] = $or_iterations; 2920 2921 if ( $parse_order eq 'numeric' ) { 2922 AND_NODE: for my $and_node ( @{$and_nodes} ) { 2923 next AND_NODE 2924 if not my $token_name = $and_node 2925 ->[Marpa::Internal::Eval_And_Node::TOKEN_NAME]; 2926 2927 next AND_NODE 2928 if not my $ranking_closure = 2929 $ranking_closures_by_symbol->{$token_name}; 2930 2931 my $rank; 2932 my @warnings; 2933 my $eval_ok; 2934 DO_EVAL: { 2935 local $Marpa::Internal::CONTEXT = 2936 [ 'setup eval and-node', $and_node ]; 2937 local $SIG{__WARN__} = 2938 sub { push @warnings, [ $_[0], ( caller 0 ) ]; }; 2939 $eval_ok = eval { $rank = $ranking_closure->(); 1; }; 2940 } ## end DO_EVAL: 2941 2942 if ( not $eval_ok or @warnings ) { 2943 my $fatal_error = $EVAL_ERROR; 2944 Marpa::Internal::code_problems( 2945 { fatal_error => $fatal_error, 2946 grammar => $grammar, 2947 eval_ok => $eval_ok, 2948 warnings => \@warnings, 2949 where => "ranking symbol $token_name", 2950 } 2951 ); 2952 } ## end if ( not $eval_ok or @warnings ) 2953 $and_node 2954 ->[Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA] = 2955 $rank; 2956 2957 } ## end for my $and_node ( @{$and_nodes} ) 2958 last SET_UP_ITERATIONS; 2959 } ## end if ( $parse_order eq 'numeric' ) 2960 2961 last SET_UP_ITERATIONS if $parse_order ne 'original'; 2962 2963 # This could be done in the ::new constructor, but intuitively 2964 # I feel it does not belong -- that someday it would get 2965 # factored out to here. 2966 AND_NODE: for my $and_node ( @{$and_nodes} ) { 2967 2968 # the absence of evaluator data means this is not a closure and-node 2969 # and does not count in the sort order 2970 next AND_NODE 2971 if not $and_node->[Marpa::Internal::Eval_And_Node::VALUE_OPS]; 2972 2973 my $rule_id = 2974 $and_node->[Marpa::Internal::Eval_And_Node::RULE_ID]; 2975 my $rule = $rules->[$rule_id]; 2976 my $greed = $rule->[Marpa::Internal::Rule::GREED]; 2977 my $priority = $rule->[Marpa::Internal::Rule::PRIORITY]; 2978 2979 next AND_NODE if not $greed and not $priority; 2980 2981 my $and_node_start_earleme = 2982 $and_node->[Marpa::Internal::Eval_And_Node::START_EARLEME]; 2983 my $and_node_end_earleme = 2984 $and_node->[Marpa::Internal::Eval_And_Node::END_EARLEME]; 2985 2986 # compute this and-nodes sort key element 2987 # insert it into the predecessor sort key elements 2988 my $location = $and_node_start_earleme; 2989 my $length; 2990 given ($greed) { 2991 when (undef) { $length = 0 } 2992 when (0) { $length = 0 } 2993 when ( $_ > 0 ) { 2994 $length = 2995 ~( ( $and_node_end_earleme - $and_node_start_earleme ) 2996 & Marpa::Internal::N_FORMAT_MASK ) 2997 } 2998 default { 2999 $length = 3000 ( $and_node_end_earleme - $and_node_start_earleme ); 3001 } 3002 } ## end given 3003 $and_node->[Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA] = 3004 [ 3005 $location, 0, 3006 ~( $priority & Marpa::Internal::N_FORMAT_MASK ), $length 3007 ]; 3008 3009 } ## end for my $and_node ( @{$and_nodes} ) 3010 3011 } ## end SET_UP_ITERATIONS: 3012 3013 my $max_parses = $evaler->[Marpa::Internal::Evaluator::MAX_PARSES]; 3014 if ( $max_parses > 0 && $parse_count >= $max_parses ) { 3015 Marpa::exception("Maximum parse count ($max_parses) exceeded"); 3016 } 3017 3018 my @tasks = ( 3019 [Marpa::Internal::Task::EVALUATE], 3020 [ ( $parse_count 3021 ? Marpa::Internal::Task::ITERATE_OR_TREE 3022 : Marpa::Internal::Task::RESET_OR_TREE 3023 ), 3024 0, 3025 {} 3026 ] 3027 ); 3028 3029 my $trace_tasks = $evaler->[Marpa::Internal::Evaluator::TRACE_TASKS]; 3030 3031 while (1) { 3032 3033 my $task_entry = pop @tasks; 3034 my $task = shift @{$task_entry}; 3035 3036 given ($task) { 3037 when (Marpa::Internal::Task::RESET_OR_NODE) { 3038 my ($or_node_id) = @{$task_entry}; 3039 my $or_node = $or_nodes->[$or_node_id]; 3040 3041 if ($trace_tasks) { 3042 print {$Marpa::Internal::TRACE_FH} 3043 "Task: RESET_OR_NODE #o$or_node_id; ", 3044 ( scalar @tasks ), " tasks pending\n" 3045 or Marpa::exception('print to trace handle failed'); 3046 } ## end if ($trace_tasks) 3047 3048 # Set up the and-choices from the children 3049 my @and_choices = (); 3050 AND_CHOICE: 3051 for my $child_and_node_id ( 3052 @{ $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] } 3053 ) 3054 { 3055 my $and_iteration = $and_iterations->[$child_and_node_id]; 3056 next AND_CHOICE if not defined $and_iteration; 3057 my $and_choice; 3058 $#{$and_choice} = Marpa::Internal::And_Choice::LAST_FIELD; 3059 $and_choice->[Marpa::Internal::And_Choice::ID] = 3060 $child_and_node_id; 3061 $and_choice->[Marpa::Internal::And_Choice::RANKING_DATA] = 3062 $and_iteration 3063 ->[Marpa::Internal::And_Iteration::RANKING_DATA]; 3064 3065 push @and_choices, $and_choice; 3066 3067 } ## end for my $child_and_node_id ( @{ $or_node->[...]}) 3068 3069 # If there are no and_choices, this or-node is 3070 # exhausted. 3071 # With no choices, there is no need to 3072 # sort the choices or to freeze any 3073 # of them. 3074 if ( not scalar @and_choices ) { 3075 $or_iterations->[$or_node_id] = undef; 3076 break; # next TASK 3077 } 3078 3079 # Sort and-choices 3080 my $or_iteration; 3081 given ($parse_order) { 3082 when ('numeric') { 3083 no integer; 3084 $or_iteration = [ 3085 map { $_->[1] } 3086 sort { $a->[0] <=> $b->[0] } 3087 map { 3088 [ $_->[ 3089 Marpa::Internal::And_Choice::RANKING_DATA 3090 ], 3091 $_ 3092 ] 3093 } @and_choices 3094 ]; 3095 } ## end when ('numeric') 3096 when ('original') { 3097 3098 $or_iteration = [ 3099 map { $_->[1] } 3100 sort { $a->[0] cmp $b->[0] } 3101 map { 3102 [ ~( join q{}, 3103 sort map { pack 'N*', @{$_} } @{ 3104 $_->[ 3105 Marpa::Internal::And_Choice::RANKING_DATA 3106 ]->[ 3107 Marpa::Internal::Original_Sort_Data::SORT_KEY 3108 ] 3109 } 3110 ), 3111 $_ 3112 ] 3113 } @and_choices 3114 ]; 3115 } ## end when ('original') 3116 default { 3117 $or_iteration = \@and_choices; 3118 } 3119 } ## end given 3120 3121 $or_iterations->[$or_node_id] = $or_iteration; 3122 3123 push @tasks, 3124 map { [ Marpa::Internal::Task::FREEZE_TREE, $_ ] } 3125 @{$or_iteration}[ 0 .. $#{$or_iteration} - 1 ]; 3126 3127 } ## end when (Marpa::Internal::Task::RESET_OR_NODE) 3128 3129 when (Marpa::Internal::Task::RESET_AND_NODE) { 3130 3131 my ($and_node_id) = @{$task_entry}; 3132 3133 if ($trace_tasks) { 3134 print {$Marpa::Internal::TRACE_FH} 3135 "Task: RESET_AND_NODE #a$and_node_id; ", 3136 ( scalar @tasks ), " tasks pending\n" 3137 or Marpa::exception('print to trace handle failed'); 3138 } ## end if ($trace_tasks) 3139 3140 my $and_node = $and_nodes->[$and_node_id]; 3141 3142 my $and_node_iteration = $and_iterations->[$and_node_id] = []; 3143 3144 $and_node_iteration 3145 ->[Marpa::Internal::And_Iteration::CURRENT_CHILD_FIELD] = 3146 defined 3147 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID] 3148 ? Marpa::Internal::Eval_And_Node::CAUSE_ID 3149 : defined $and_node 3150 ->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID] 3151 ? Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 3152 : undef; 3153 3154 push @tasks, 3155 [ Marpa::Internal::Task::SETUP_AND_NODE, $and_node_id ]; 3156 3157 } ## end when (Marpa::Internal::Task::RESET_AND_NODE) 3158 3159 # Set up task for followup on both initialization and iteration 3160 # This is safe to call on exhausted nodes 3161 when (Marpa::Internal::Task::SETUP_AND_NODE) { 3162 3163 my ($and_node_id) = @{$task_entry}; 3164 3165 if ($trace_tasks) { 3166 print {$Marpa::Internal::TRACE_FH} 3167 "Task: SETUP_AND_NODE #a$and_node_id; ", 3168 ( scalar @tasks ), " tasks pending\n" 3169 or Marpa::exception('print to trace handle failed'); 3170 } ## end if ($trace_tasks) 3171 3172 my $and_node = $and_nodes->[$and_node_id]; 3173 3174 my $and_node_iteration = $and_iterations->[$and_node_id]; 3175 break if not $and_node_iteration; 3176 3177 my $cause; 3178 my $cause_id; 3179 my $cause_or_node_iteration; 3180 my $cause_and_node_choice; 3181 3182 # assignment instead of comparison intentional 3183 if ( $cause_id = 3184 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID] ) 3185 { 3186 $cause = $or_nodes->[$cause_id]; 3187 $cause_or_node_iteration = $or_iterations->[$cause_id]; 3188 3189 # If there is a predecessor, but it is 3190 # exhausted, this and-node is exhausted. 3191 if ( not $cause_or_node_iteration ) { 3192 $and_iterations->[$and_node_id] = undef; 3193 break; 3194 } 3195 3196 $cause_and_node_choice = $cause_or_node_iteration->[-1]; 3197 } ## end if ( $cause_id = $and_node->[...]) 3198 3199 my $predecessor; 3200 my $predecessor_id; 3201 my $predecessor_or_node_iteration; 3202 my $predecessor_and_node_choice; 3203 3204 # assignment instead of comparison intentional 3205 if ( $predecessor_id = 3206 $and_node 3207 ->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID] ) 3208 { 3209 $predecessor = $or_nodes->[$predecessor_id]; 3210 $predecessor_or_node_iteration = 3211 $or_iterations->[$predecessor_id]; 3212 3213 # If there is a predecessor, but it is 3214 # exhausted, this and-node is exhausted. 3215 if ( not $predecessor_or_node_iteration ) { 3216 $and_iterations->[$and_node_id] = undef; 3217 break; # next TASK 3218 } 3219 3220 $predecessor_and_node_choice = 3221 $predecessor_or_node_iteration->[-1]; 3222 3223 } ## end if ( $predecessor_id = $and_node->[...]) 3224 3225 # The rest of the processing is for ranking parses 3226 break if $parse_order eq 'none'; # next TASK 3227 3228 my $cause_ranking_data; 3229 my $cause_and_node_iteration; 3230 if ( defined $cause_and_node_choice ) { 3231 my $cause_and_node_id = $cause_and_node_choice 3232 ->[Marpa::Internal::And_Choice::ID]; 3233 $cause_and_node_iteration = 3234 $and_iterations->[$cause_and_node_id]; 3235 $cause_ranking_data = $cause_and_node_iteration 3236 ->[Marpa::Internal::And_Iteration::RANKING_DATA]; 3237 } ## end if ( defined $cause_and_node_choice ) 3238 3239 my $predecessor_ranking_data; 3240 my $predecessor_and_node_iteration; 3241 if ( defined $predecessor_and_node_choice ) { 3242 my $predecessor_and_node_id = $predecessor_and_node_choice 3243 ->[Marpa::Internal::And_Choice::ID]; 3244 $predecessor_and_node_iteration = 3245 $and_iterations->[$predecessor_and_node_id]; 3246 $predecessor_ranking_data = 3247 $predecessor_and_node_iteration 3248 ->[Marpa::Internal::And_Iteration::RANKING_DATA]; 3249 } ## end if ( defined $predecessor_and_node_choice ) 3250 3251 my $token_name = 3252 $and_node->[Marpa::Internal::Eval_And_Node::TOKEN_NAME]; 3253 3254 if ( $parse_order eq 'numeric' ) { 3255 my $ranking_closure = $and_node 3256 ->[Marpa::Internal::Eval_And_Node::RANKING_CLOSURE]; 3257 if ( not $ranking_closure ) { 3258 3259 no integer; 3260 3261 # Initialize with the rank of this node 3262 my $rank = 3263 $and_node->[ 3264 Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA 3265 ]; 3266 3267 ### assert: defined $rank 3268 3269 #Then add cause and predecessor 3270 # if they exist 3271 if ($cause_and_node_choice) { 3272 $rank 3273 += $cause_and_node_iteration->[ 3274 Marpa::Internal::And_Iteration::RANKING_DATA 3275 ]; 3276 3277 ### and node: Marpa'Evaluator'show_and_node($evaler, $and_nodes->[$cause_and_node_choice->[Marpa'Internal'And_Choice'ID]], 99) 3278 3279 ### assert: defined $cause_and_node_iteration->[ Marpa'Internal'And_Iteration'RANKING_DATA ] 3280 3281 } ## end if ($cause_and_node_choice) 3282 if ($predecessor_and_node_choice) { 3283 $rank 3284 += $predecessor_and_node_iteration->[ 3285 Marpa::Internal::And_Iteration::RANKING_DATA 3286 ]; 3287 } ## end if ($predecessor_and_node_choice) 3288 3289 $and_node_iteration 3290 ->[Marpa::Internal::And_Iteration::RANKING_DATA] = 3291 $rank; 3292 3293 # With the rank processing finished, the 3294 # SETUP_AND_NODE task is finished 3295 break; # next TASK 3296 3297 } ## end if ( not $ranking_closure ) 3298 my $rank; 3299 my @warnings; 3300 my $eval_ok; 3301 my $eval_error; 3302 DO_EVAL: { 3303 local $EVAL_ERROR = undef; 3304 local $Marpa::Internal::CONTEXT = 3305 [ 'rank eval and-node', $and_node ]; 3306 local $SIG{__WARN__} = 3307 sub { push @warnings, [ $_[0], ( caller 0 ) ]; }; 3308 $eval_ok = eval { $rank = $ranking_closure->(); 1; }; 3309 $eval_error = $EVAL_ERROR; 3310 } ## end DO_EVAL: 3311 3312 if ( not $eval_ok or @warnings ) { 3313 my $rule_id = $and_node 3314 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 3315 my $rule = $rules->[$rule_id]; 3316 Marpa::Internal::code_problems( 3317 { fatal_error => $eval_error, 3318 grammar => $grammar, 3319 eval_ok => $eval_ok, 3320 warnings => \@warnings, 3321 where => 'ranking rule', 3322 long_where => 'ranking rule: ' 3323 . Marpa::brief_rule($rule), 3324 } 3325 ); 3326 } ## end if ( not $eval_ok or @warnings ) 3327 3328 if ( not defined $rank ) { 3329 my $rule_id = $and_node 3330 ->[Marpa::Internal::Eval_And_Node::RULE_ID]; 3331 my $rule = $rules->[$rule_id]; 3332 Marpa::exception( 3333 'numeric ranking action returned undef, rule: ', 3334 Marpa::brief_rule($rule), 3335 ); 3336 } ## end if ( not defined $rank ) 3337 3338 $and_node_iteration 3339 ->[Marpa::Internal::And_Iteration::RANKING_DATA] = 3340 $rank; 3341 3342 ### assert: defined $rank 3343 3344 # With the rank processing finished, the 3345 # SETUP_AND_NODE task is finished 3346 break; # next TASK 3347 3348 } ## end if ( $parse_order eq 'numeric' ) 3349 3350 # The rest of the processing is for the original parse 3351 # ranking 3352 # 3353 break if $parse_order ne 'original'; # next TASK 3354 3355 my $and_node_end_earleme = 3356 $and_node->[Marpa::Internal::Eval_And_Node::END_EARLEME]; 3357 3358 my $sort_element = $and_node 3359 ->[Marpa::Internal::Eval_And_Node::FIXED_RANKING_DATA]; 3360 my @current_sort_elements = 3361 $sort_element ? ($sort_element) : (); 3362 my $trailing_nulls = 0; 3363 3364 my $cause_sort_elements = []; 3365 3366 if ( defined $cause_ranking_data ) { 3367 $cause_sort_elements = $cause_ranking_data 3368 ->[Marpa::Internal::Original_Sort_Data::SORT_KEY]; 3369 3370 #<<< As of 2 Nov 2009 perltidy cycles on this 3371 $trailing_nulls += $cause_ranking_data->[ 3372 Marpa::Internal::Original_Sort_Data::TRAILING_NULLS ]; 3373 #>>> 3374 } ## end if 3375 3376 my $predecessor_sort_elements = []; 3377 my $predecessor_end_earleme; 3378 my $internal_nulls = 0; 3379 3380 if ( defined $predecessor_ranking_data ) { 3381 $predecessor_end_earleme = $predecessor 3382 ->[Marpa::Internal::Eval_Or_Node::END_EARLEME]; 3383 3384 $predecessor_sort_elements = $predecessor_ranking_data 3385 ->[Marpa::Internal::Original_Sort_Data::SORT_KEY]; 3386 #<<< As of 2 Nov 2009 perltidy cycles on this 3387 $internal_nulls = $predecessor_ranking_data->[ 3388 Marpa::Internal::Original_Sort_Data::TRAILING_NULLS ]; 3389 #>>> 3390 if ( $predecessor_end_earleme == $and_node_end_earleme ) { 3391 $trailing_nulls += $internal_nulls; 3392 } 3393 } ## end if ( defined $predecessor_ranking_data ) 3394 3395 PROCESS_TOKEN: { 3396 last PROCESS_TOKEN if not defined $token_name; 3397 my $token_id = $symbol_hash->{$token_name}; 3398 my $token = $symbols->[$token_id]; 3399 3400 if ( $token->[Marpa::Internal::Symbol::NULLABLE] ) { 3401 $trailing_nulls += 1; 3402 } 3403 3404 my $greed = $token->[Marpa::Internal::Symbol::GREED]; 3405 last PROCESS_TOKEN if not $greed; 3406 3407 my $token_start_earleme = $predecessor_end_earleme 3408 // $and_node 3409 ->[Marpa::Internal::Eval_And_Node::START_EARLEME]; 3410 my $length = 3411 $token->[Marpa::Internal::Symbol::GREED] > 0 3412 ? ~( ( $and_node_end_earleme - $token_start_earleme ) 3413 & Marpa::Internal::N_FORMAT_MASK ) 3414 : ( $and_node_end_earleme - $token_start_earleme ); 3415 3416 push @current_sort_elements, 3417 [ 3418 $token_start_earleme, $internal_nulls, 3419 ~0, $length, 3420 ]; 3421 3422 } ## end PROCESS_TOKEN: 3423 3424 if ($internal_nulls) { 3425 my @new_cause_sort_elements = (); 3426 SORT_ELEMENT: 3427 for my $cause_sort_element ( @{$cause_sort_elements} ) { 3428 my ($location, $preceding_nulls, 3429 $priority, $length 3430 ) = @{$cause_sort_element}; 3431 3432 # If it will be unchanged, just push the reference to save memory 3433 if ( $location != $predecessor_end_earleme ) { 3434 push @new_cause_sort_elements, 3435 $cause_sort_element; 3436 next SORT_ELEMENT; 3437 } 3438 push @new_cause_sort_elements, 3439 [ 3440 $location, $preceding_nulls + $internal_nulls, 3441 $priority, $length 3442 ]; 3443 } ## end for my $cause_sort_element ( @{$cause_sort_elements}) 3444 $cause_sort_elements = \@new_cause_sort_elements; 3445 } ## end if ($internal_nulls) 3446 3447 my $and_node_sort_data = $and_node_iteration 3448 ->[Marpa::Internal::And_Iteration::RANKING_DATA] = []; 3449 3450 $and_node_sort_data 3451 ->[Marpa::Internal::Original_Sort_Data::SORT_KEY] = [ 3452 @current_sort_elements, @{$predecessor_sort_elements}, 3453 @{$cause_sort_elements} 3454 ]; 3455 3456 $and_node_sort_data 3457 ->[Marpa::Internal::Original_Sort_Data::TRAILING_NULLS] = 3458 $trailing_nulls; 3459 3460 if ( defined $cause 3461 and defined $predecessor ) 3462 { 3463 my ( $cause_sort_string, $predecessor_sort_string ) = 3464 map { 3465 ~( join q{}, sort map { pack 'N*', @{$_} } @{$_} ) 3466 } ( $cause_sort_elements, 3467 $predecessor_sort_elements ); 3468 my $current_child_field = 3469 $cause_sort_string ge $predecessor_sort_string 3470 ? Marpa::Internal::Eval_And_Node::CAUSE_ID 3471 : Marpa::Internal::Eval_And_Node::PREDECESSOR_ID; 3472 3473 #<<< current (2009 Oct 20) version of perltidy cycles on this 3474 3475 $and_node_iteration->[ 3476 Marpa::Internal::And_Iteration::CURRENT_CHILD_FIELD ] 3477 = $current_child_field; 3478 3479 #>>> 3480 } ## end if ( defined $cause and defined $predecessor ) 3481 3482 } ## end when 3483 3484=begin Implementation: 3485 3486The visited arguments is needed for RESET_OR_TREE and RESET_AND_TREE 3487because otherwise every node will be reset once for every possible 3488derivation involving it. Resets are idempotent, so in one sense this 3489is harmless. But in some cases the number of derivations is exponential 3490in the size of the input and the CPU time consumed can be staggering. 3491 3492Preventing re-visits to reset items is NOT the same as cycle prevention. 3493Reset nodes are tracked over the entire tree. Cycles only occur if a 3494node appears more than once on the path back to the root node. 3495 3496=end Implementation: 3497 3498=cut 3499 3500 when (Marpa::Internal::Task::RESET_OR_TREE) { 3501 3502 my ( $or_node_id, $path, $visited ) = @{$task_entry}; 3503 3504 if ($trace_tasks) { 3505 print {$Marpa::Internal::TRACE_FH} 3506 "Task: RESET_OR_TREE from #o$or_node_id; ", 3507 ( scalar @tasks ), " tasks pending\n" 3508 or Marpa::exception('print to trace handle failed'); 3509 } ## end if ($trace_tasks) 3510 3511 my $or_node = $or_nodes->[$or_node_id]; 3512 $visited //= {}; 3513 my @unvisited_children = 3514 grep { !( $visited->{$_}++ ) } 3515 @{ $or_node->[Marpa::Internal::Eval_Or_Node::CHILD_IDS] }; 3516 push @tasks, 3517 [ Marpa::Internal::Task::RESET_OR_NODE, $or_node_id ], 3518 map { 3519 [ Marpa::Internal::Task::NEXT_AND_TREE, 3520 $_, $path, $visited 3521 ] 3522 } @unvisited_children; 3523 } ## end when (Marpa::Internal::Task::RESET_OR_TREE) 3524 3525 # This is a bit hack-ish. It's becomes a reset or 3526 # an iterate depending on the presence of absence 3527 # of the 3rd "visited" argument. 3528 when (Marpa::Internal::Task::NEXT_AND_TREE) { 3529 my ( $and_node_id, $path, $visited ) = @{$task_entry}; 3530 3531 if ($trace_tasks) { 3532 print {$Marpa::Internal::TRACE_FH} 3533 "Task: NEXT_AND_TREE from #a$and_node_id; ", 3534 ( scalar @tasks ), " tasks pending\n" 3535 or Marpa::exception('print to trace handle failed'); 3536 } ## end if ($trace_tasks) 3537 3538 my $and_node = $and_nodes->[$and_node_id]; 3539 3540 if ( my $tree_ops = 3541 $and_node->[Marpa::Internal::Eval_And_Node::TREE_OPS] ) 3542 { 3543 3544 my $use_this_and_node = 1; 3545 my @add_to_path = (); 3546 my $op_ix = 0; 3547 TREE_OP: while ( $op_ix <= $#{$tree_ops} ) { 3548 3549 my $tree_op = $tree_ops->[ $op_ix++ ]; 3550 my $rule_id; 3551 my $max_count; 3552 given ($tree_op) { 3553 when (Marpa::Internal::Evaluator_Op::CYCLE) { 3554 my @keys = 3555 map { 'o' . $_ } 3556 grep {defined} @{$and_node}[ 3557 Marpa::Internal::Eval_And_Node::CAUSE_ID, 3558 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 3559 ]; 3560 3561 if ( grep { $path->{$_} } @keys ) { 3562 $use_this_and_node = 0; 3563 } 3564 else { 3565 push @add_to_path, 3566 map { [ $_, 1 ] } @keys; 3567 } 3568 } ## end when (Marpa::Internal::Evaluator_Op::CYCLE) 3569 when ( Marpa::Internal::Evaluator_Op::COUNTED_RULE 3570 ) 3571 { 3572 3573 # counted rule logic is not tested 3574 $rule_id = $tree_ops->[ $op_ix++ ]; 3575 $max_count = $tree_ops->[ $op_ix++ ]; 3576 my $key = "r$rule_id"; 3577 my $count = $path->{$key} // 0; 3578 if ( ++$count >= $max_count ) { 3579 $use_this_and_node = 0; 3580 } 3581 else { 3582 push @add_to_path, [ $key, $count ]; 3583 } 3584 } ## end when ( Marpa::Internal::Evaluator_Op::COUNTED_RULE ) 3585 default { 3586 Marpa::exception("Unknown tree op: $_"); 3587 } 3588 } ## end given 3589 } ## end while ( $op_ix <= $#{$tree_ops} ) 3590 3591 # This would be a cycle. Mark the and-node 3592 # exhausted and move on. 3593 # Note we take some care not to modify 3594 # $path until we have to. 3595 if ( not $use_this_and_node ) { 3596 $and_iterations->[$and_node_id] = undef; 3597 3598 break; # next TASK 3599 } 3600 3601 # The path must be 3602 # re-copied. If it is shared 3603 # among branches, it will become 3604 # incorrect. 3605 # For efficiency, we use copy-on-write. 3606 if ( scalar @add_to_path ) { 3607 my %new_path = %{$path}; 3608 for my $add_to_path (@add_to_path) { 3609 my ( $key, $value ) = @{$add_to_path}; 3610 3611 $new_path{$key} = $value; 3612 } 3613 $path = \%new_path; 3614 } ## end if ( scalar @add_to_path ) 3615 3616 } ## end if ( my $tree_ops = $and_node->[...]) 3617 3618 # If there is no $visited argument, 3619 # this is an iteration, not a reset 3620 push @tasks, 3621 [ 3622 ( $visited 3623 ? Marpa::Internal::Task::RESET_AND_TREE 3624 : Marpa::Internal::Task::ITERATE_AND_TREE 3625 ), 3626 $and_node_id, 3627 $path, $visited 3628 ]; 3629 3630 } ## end when (Marpa::Internal::Task::NEXT_AND_TREE) 3631 3632 when (Marpa::Internal::Task::RESET_AND_TREE) { 3633 my ( $and_node_id, $path, $visited ) = @{$task_entry}; 3634 3635 if ($trace_tasks) { 3636 print {$Marpa::Internal::TRACE_FH} 3637 "Task: RESET_AND_TREE from #a$and_node_id; ", 3638 ( scalar @tasks ), " tasks pending\n" 3639 or Marpa::exception('print to trace handle failed'); 3640 } ## end if ($trace_tasks) 3641 3642 my $and_node = $and_nodes->[$and_node_id]; 3643 3644 push @tasks, 3645 [ Marpa::Internal::Task::RESET_AND_NODE, $and_node_id ], 3646 map { 3647 [ Marpa::Internal::Task::RESET_OR_TREE, 3648 $_, $path, $visited 3649 ] 3650 } 3651 grep { defined $_ } @{$and_node}[ 3652 Marpa::Internal::Eval_And_Node::CAUSE_ID, 3653 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 3654 ]; 3655 3656 } ## end when (Marpa::Internal::Task::RESET_AND_TREE) 3657 3658 when (Marpa::Internal::Task::ITERATE_AND_TREE) { 3659 my ( $and_node_id, $path ) = @{$task_entry}; 3660 3661 if ($trace_tasks) { 3662 print {$Marpa::Internal::TRACE_FH} 3663 "Task: ITERATE_AND_TREE from #a$and_node_id; ", 3664 ( scalar @tasks ), " tasks pending\n" 3665 or Marpa::exception('print to trace handle failed'); 3666 } ## end if ($trace_tasks) 3667 3668 push @tasks, 3669 [ Marpa::Internal::Task::SETUP_AND_NODE, $and_node_id ]; 3670 3671 # Iteration of and-node without child always results in 3672 # exhausted and-node 3673 my $current_child_field = 3674 $and_iterations->[$and_node_id] 3675 ->[Marpa::Internal::And_Iteration::CURRENT_CHILD_FIELD]; 3676 if ( not defined $current_child_field ) { 3677 $and_iterations->[$and_node_id] = undef; 3678 break; # next TASK 3679 } 3680 3681 my $and_node = $and_nodes->[$and_node_id]; 3682 3683 my $cause_id = 3684 $and_node->[Marpa::Internal::Eval_And_Node::CAUSE_ID]; 3685 my $predecessor_id = $and_node 3686 ->[Marpa::Internal::Eval_And_Node::PREDECESSOR_ID]; 3687 if ( defined $cause_id and defined $predecessor_id ) { 3688 push @tasks, 3689 [ 3690 Marpa::Internal::Task::ITERATE_AND_TREE_2, 3691 $and_node_id, $path 3692 ]; 3693 } ## end if ( defined $cause_id and defined $predecessor_id ) 3694 3695 push @tasks, 3696 [ 3697 Marpa::Internal::Task::ITERATE_OR_TREE, 3698 $and_node->[$current_child_field], 3699 $path 3700 ]; 3701 3702 } ## end when (Marpa::Internal::Task::ITERATE_AND_TREE) 3703 3704 when (Marpa::Internal::Task::ITERATE_AND_TREE_2) { 3705 3706 # We always have both a cause and a predecessor if we are 3707 # in this task. 3708 3709 my ( $and_node_id, $path ) = @{$task_entry}; 3710 3711 if ($trace_tasks) { 3712 print {$Marpa::Internal::TRACE_FH} 3713 "Task: ITERATE_AND_TREE_2 from #a$and_node_id; ", 3714 ( scalar @tasks ), " tasks pending\n" 3715 or Marpa::exception('print to trace handle failed'); 3716 } ## end if ($trace_tasks) 3717 3718 my $and_node = $and_nodes->[$and_node_id]; 3719 3720 my $current_child_field = 3721 $and_iterations->[$and_node_id] 3722 ->[Marpa::Internal::And_Iteration::CURRENT_CHILD_FIELD]; 3723 3724 # if the current child is not exhausted, the last task 3725 # successfully iterated it. So SETUP_AND_NODE 3726 # (which is already on the tasks stack) is all 3727 # that is needed. 3728 break 3729 if defined 3730 $or_iterations->[ $and_node->[$current_child_field] ]; 3731 3732 my $other_child_id = $and_node->[ 3733 $current_child_field 3734 == Marpa::Internal::Eval_And_Node::CAUSE_ID 3735 ? Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 3736 : Marpa::Internal::Eval_And_Node::CAUSE_ID 3737 ]; 3738 3739 push @tasks, 3740 [ 3741 Marpa::Internal::Task::ITERATE_AND_TREE_3, $and_node_id, 3742 $path 3743 ], 3744 [ 3745 Marpa::Internal::Task::ITERATE_OR_TREE, $other_child_id, 3746 $path 3747 ]; 3748 3749 } ## end when (Marpa::Internal::Task::ITERATE_AND_TREE_2) 3750 3751 when (Marpa::Internal::Task::ITERATE_AND_TREE_3) { 3752 3753 # We always have both a cause and a predecessor if we are 3754 # in this task. 3755 my ( $and_node_id, $path ) = @{$task_entry}; 3756 3757 if ($trace_tasks) { 3758 print {$Marpa::Internal::TRACE_FH} 3759 "Task: ITERATE_AND_TREE_3 from #a$and_node_id; ", 3760 ( scalar @tasks ), " tasks pending\n" 3761 or Marpa::exception('print to trace handle failed'); 3762 } ## end if ($trace_tasks) 3763 3764 my $and_node = $and_nodes->[$and_node_id]; 3765 3766 my @exhausted_children = 3767 grep { not defined $or_iterations->[$_] } @{$and_node}[ 3768 Marpa::Internal::Eval_And_Node::CAUSE_ID, 3769 Marpa::Internal::Eval_And_Node::PREDECESSOR_ID 3770 ]; 3771 3772 # If both children exhausted, this and node is exhausted 3773 # Let SETUP_AND_NODE (which is already on the tasks stack) 3774 # deal with that. 3775 break if @exhausted_children >= 2; 3776 3777 # The RESET_OR_TREE either will find a valid iteration, 3778 # or leave the one exhausted child still exhausted. 3779 # Either way SETUP_AND_NODE 3780 # (which is already on the tasks stack) 3781 # can deal with that. 3782 push @tasks, 3783 [ 3784 Marpa::Internal::Task::RESET_OR_TREE, 3785 $exhausted_children[0], 3786 $path 3787 ]; 3788 3789 } ## end when (Marpa::Internal::Task::ITERATE_AND_TREE_3) 3790 3791 when (Marpa::Internal::Task::ITERATE_OR_NODE) { 3792 my ($or_node_id) = @{$task_entry}; 3793 3794 if ($trace_tasks) { 3795 print {$Marpa::Internal::TRACE_FH} 3796 "Task: ITERATE_OR_NODE #o$or_node_id; ", 3797 ( scalar @tasks ), " tasks pending\n" 3798 or Marpa::exception('print to trace handle failed'); 3799 } ## end if ($trace_tasks) 3800 3801 my $and_choices = $or_iterations->[$or_node_id]; 3802 3803 my $current_and_choice = $and_choices->[-1]; 3804 my $current_and_node_id = 3805 $current_and_choice->[Marpa::Internal::And_Choice::ID]; 3806 my $current_and_iteration = 3807 $and_iterations->[$current_and_node_id]; 3808 3809 # If the current and-choice is exhausted ... 3810 if ( not defined $current_and_iteration ) { 3811 pop @{$and_choices}; 3812 3813 if ($trace_tasks) { 3814 print {$Marpa::Internal::TRACE_FH} 3815 "...ITERATE_OR_NODE #a$current_and_node_id exhausted\n", 3816 or 3817 Marpa::exception('print to trace handle failed'); 3818 } ## end if ($trace_tasks) 3819 3820 # If there are no more choices, the or-node is exhausted ... 3821 if ( scalar @{$and_choices} == 0 ) { 3822 if ($trace_tasks) { 3823 print {$Marpa::Internal::TRACE_FH} 3824 "...ITERATE_OR_NODE #o$or_node_id exhausted\n", 3825 or Marpa::exception( 3826 'print to trace handle failed'); 3827 } ## end if ($trace_tasks) 3828 $or_iterations->[$or_node_id] = undef; 3829 break; 3830 } ## end if ( scalar @{$and_choices} == 0 ) 3831 3832 # Thaw out the current and-choice, 3833 push @tasks, 3834 [ 3835 Marpa::Internal::Task::THAW_TREE, 3836 $and_choices->[-1] 3837 ]; 3838 3839 break; # next TASK 3840 3841 } ## end if ( not defined $current_and_iteration ) 3842 3843 # If we are here the current and-choice is not exhausted, 3844 # but it may have been iterated to the point where it is 3845 # no longer the first in sort order. 3846 3847 # Refresh and-choice's fields 3848 $current_and_choice 3849 ->[Marpa::Internal::And_Choice::RANKING_DATA] = 3850 $current_and_iteration 3851 ->[Marpa::Internal::And_Iteration::RANKING_DATA]; 3852 3853 # The rest of the logic is for keeping the order correct 3854 # for the "original" parse ordering 3855 3856 break # next TASK 3857 if $parse_order eq 'none'; 3858 3859 # If only one choice still active, 3860 # clearly no need to 3861 # worry about sorting alternatives. 3862 break if @{$and_choices} <= 1; 3863 3864 my $insert_point; 3865 given ($parse_order) { 3866 when ('numeric') { 3867 my $current_sort_key = $current_and_choice 3868 ->[Marpa::Internal::And_Choice::RANKING_DATA]; 3869 no integer; 3870 AND_CHOICE: 3871 for ( 3872 my $and_choice_ix = $#{$and_choices} - 1; 3873 $and_choice_ix >= 0; 3874 $and_choice_ix-- 3875 ) 3876 { 3877 if ( $and_choices->[$and_choice_ix] 3878 ->[Marpa::Internal::And_Choice::RANKING_DATA] 3879 <= $current_sort_key ) 3880 { 3881 $insert_point = $and_choice_ix + 1; 3882 last AND_CHOICE; 3883 } ## end if ( $and_choices->[$and_choice_ix]->[...]) 3884 } ## end for ( my $and_choice_ix = $#{$and_choices} - 1; ...) 3885 } ## end when ('numeric') 3886 when ('original') { 3887 my $current_sort_key = ~( 3888 join q{}, 3889 sort map { pack 'N*', @{$_} } @{ 3890 $current_and_choice->[ 3891 Marpa::Internal::And_Choice::RANKING_DATA] 3892 ->[ 3893 Marpa::Internal::Original_Sort_Data::SORT_KEY 3894 ] 3895 } 3896 ); 3897 3898 AND_CHOICE: 3899 for ( 3900 my $and_choice_ix = $#{$and_choices} - 1; 3901 $and_choice_ix >= 0; 3902 $and_choice_ix-- 3903 ) 3904 { 3905 if (~( join q{}, 3906 sort map { pack 'N*', @{$_} } @{ 3907 $and_choices->[$and_choice_ix]->[ 3908 Marpa::Internal::And_Choice::RANKING_DATA 3909 ]->[ 3910 Marpa::Internal::Original_Sort_Data::SORT_KEY 3911 ] 3912 } 3913 ) le $current_sort_key 3914 ) 3915 { 3916 $insert_point = $and_choice_ix + 1; 3917 last AND_CHOICE; 3918 } ## end if ( ~( join q{}, sort map { pack 'N*', @{$_} } @{ ...})) 3919 } ## end for ( my $and_choice_ix = $#{$and_choices} - 1; ...) 3920 3921 } ## end when ('original') 3922 } ## end given 3923 3924 $insert_point //= 0; 3925 3926 # If current choice would be inserted where it already 3927 # is now, we're done 3928 break if $insert_point == $#{$and_choices}; 3929 3930 my $former_current_choice = pop @{$and_choices}; 3931 splice @{$and_choices}, $insert_point, 0, 3932 $former_current_choice; 3933 3934 if ($trace_tasks) { 3935 printf {$Marpa::Internal::TRACE_FH} ( 3936 "...ITERATE_OR_NODE Sorting and-choices\n", 3937 "...ITERATE_OR_NODE Replacing #a%d with #a%d\n", 3938 $former_current_choice 3939 ->[Marpa::Internal::And_Choice::ID], 3940 $and_choices->[-1]->[Marpa::Internal::And_Choice::ID], 3941 ) or Marpa::exception('print to trace handle failed'); 3942 } ## end if ($trace_tasks) 3943 3944 push @tasks, 3945 [ Marpa::Internal::Task::THAW_TREE, $and_choices->[-1] ], 3946 [ 3947 Marpa::Internal::Task::FREEZE_TREE, 3948 $former_current_choice 3949 ]; 3950 3951 } ## end when (Marpa::Internal::Task::ITERATE_OR_NODE) 3952 3953 when (Marpa::Internal::Task::ITERATE_OR_TREE) { 3954 my ( $or_node_id, $path ) = @{$task_entry}; 3955 3956 if ($trace_tasks) { 3957 print {$Marpa::Internal::TRACE_FH} 3958 "Task: ITERATE_OR_TREE #o$or_node_id; ", 3959 ( scalar @tasks ), " tasks pending\n" 3960 or Marpa::exception('print to trace handle failed'); 3961 } ## end if ($trace_tasks) 3962 3963 my $or_node = $or_nodes->[$or_node_id]; 3964 3965 my $current_and_node_id = 3966 $or_iterations->[$or_node_id]->[-1] 3967 ->[Marpa::Internal::And_Choice::ID]; 3968 push @tasks, 3969 [ Marpa::Internal::Task::ITERATE_OR_NODE, $or_node_id ], 3970 [ 3971 Marpa::Internal::Task::NEXT_AND_TREE, 3972 $current_and_node_id, $path 3973 ]; 3974 } ## end when (Marpa::Internal::Task::ITERATE_OR_TREE) 3975 3976 when (Marpa::Internal::Task::FREEZE_TREE) { 3977 my ($and_choice) = @{$task_entry}; 3978 3979 my $and_node_id = 3980 $and_choice->[Marpa::Internal::And_Choice::ID]; 3981 3982 if ($trace_tasks) { 3983 printf {$Marpa::Internal::TRACE_FH} 3984 "Task: FREEZE_TREE; #a%d; %d tasks pending\n", 3985 $and_node_id, ( scalar @tasks ) 3986 or Marpa::exception('print to trace handle failed'); 3987 } ## end if ($trace_tasks) 3988 3989 my @work_list = ($and_node_id); 3990 my @and_slice = (); 3991 my @or_slice = (); 3992 3993 AND_NODE: while ( scalar @work_list ) { 3994 my $descendant_and_node_id = pop @work_list; 3995 push @and_slice, $descendant_and_node_id; 3996 my @descendant_or_node_ids = grep { defined $_ } 3997 map { $and_nodes->[$descendant_and_node_id]->[$_] } 3998 ( Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 3999 Marpa::Internal::Eval_And_Node::CAUSE_ID 4000 ); 4001 push @or_slice, @descendant_or_node_ids; 4002 push @work_list, map { 4003 $or_iterations->[$_]->[-1] 4004 ->[Marpa::Internal::And_Choice::ID] 4005 } @descendant_or_node_ids; 4006 } ## end while ( scalar @work_list ) 4007 4008 my @or_values = @{$or_iterations}[@or_slice]; 4009 my @and_values = @{$and_iterations}[@and_slice]; 4010 4011 $and_choice->[Marpa::Internal::And_Choice::FROZEN_ITERATION] = 4012 Storable::freeze( 4013 [ \@and_slice, \@and_values, \@or_slice, \@or_values ] ); 4014 4015 } ## end when (Marpa::Internal::Task::FREEZE_TREE) 4016 4017 when (Marpa::Internal::Task::THAW_TREE) { 4018 my ($and_choice) = @{$task_entry}; 4019 4020 my $and_node_id = 4021 $and_choice->[Marpa::Internal::And_Choice::ID]; 4022 4023 if ($trace_tasks) { 4024 printf {$Marpa::Internal::TRACE_FH} 4025 "Task: THAW_TREE; and-node #a%d; %d tasks pending\n", 4026 $and_node_id, ( scalar @tasks ) 4027 or Marpa::exception('print to trace handle failed'); 4028 } ## end if ($trace_tasks) 4029 4030 # If we are here, the current choice is new 4031 # It must be thawed and its frozen iteration thrown away 4032 my ( $and_slice, $and_values, $or_slice, $or_values ) = @{ 4033 Storable::thaw( 4034 $and_choice 4035 ->[Marpa::Internal::And_Choice::FROZEN_ITERATION] 4036 ) 4037 }; 4038 4039 @{$and_iterations}[ @{$and_slice} ] = @{$and_values}; 4040 @{$or_iterations}[ @{$or_slice} ] = @{$or_values}; 4041 4042 # Refresh and-choice's fields 4043 my $current_and_iteration = $and_iterations->[$and_node_id]; 4044 $and_choice->[Marpa::Internal::And_Choice::RANKING_DATA] = 4045 $current_and_iteration 4046 ->[Marpa::Internal::And_Iteration::RANKING_DATA]; 4047 4048 # Once it's unfrozen, it's subject to change, so the 4049 # the frozen version will become invalid. 4050 # We undef it. 4051 $and_choice->[Marpa::Internal::And_Choice::FROZEN_ITERATION] = 4052 undef; 4053 4054 } ## end when (Marpa::Internal::Task::THAW_TREE) 4055 4056 when (Marpa::Internal::Task::EVALUATE) { 4057 4058 if ($trace_tasks) { 4059 print { 4060 $Marpa::Internal::TRACE_FH 4061 } 4062 'Task: EVALUATE; ', ( scalar @tasks ), " tasks pending\n" 4063 or Marpa::exception('print to trace handle failed'); 4064 } ## end if ($trace_tasks) 4065 4066 # If the top or node is exhausted, we are done 4067 my $top_or_iteration = $or_iterations->[0]; 4068 return if not $top_or_iteration; 4069 4070 # Write the and-nodes out in preorder 4071 my @preorder = (); 4072 4073 # Initialize the work list to the top and-node 4074 my @work_list = ( 4075 $and_nodes->[ 4076 $top_or_iteration->[-1] 4077 ->[Marpa::Internal::And_Choice::ID] 4078 ] 4079 ); 4080 4081 AND_NODE: while ( scalar @work_list ) { 4082 my $and_node = pop @work_list; 4083 push @work_list, map { 4084 $and_nodes->[ $or_iterations->[$_]->[-1] 4085 ->[Marpa::Internal::And_Choice::ID] ] 4086 } 4087 grep { defined $_ } 4088 map { $and_node->[$_] } 4089 ( Marpa::Internal::Eval_And_Node::PREDECESSOR_ID, 4090 Marpa::Internal::Eval_And_Node::CAUSE_ID 4091 ); 4092 push @preorder, $and_node; 4093 } ## end while ( scalar @work_list ) 4094 4095 my $action_object_class = 4096 $grammar->[Marpa::Internal::Grammar::ACTION_OBJECT]; 4097 my $action_object_constructor = $evaler 4098 ->[Marpa::Internal::Evaluator::ACTION_OBJECT_CONSTRUCTOR]; 4099 4100 my $action_object; 4101 4102 if ($action_object_constructor) { 4103 my @warnings; 4104 my $eval_ok; 4105 my $fatal_error; 4106 DO_EVAL: { 4107 local $EVAL_ERROR = undef; 4108 local $SIG{__WARN__} = sub { 4109 push @warnings, [ $_[0], ( caller 0 ) ]; 4110 }; 4111 4112 $eval_ok = eval { 4113 $action_object = 4114 $action_object_constructor->( 4115 $action_object_class); 4116 1; 4117 }; 4118 $fatal_error = $EVAL_ERROR; 4119 } ## end DO_EVAL: 4120 4121 if ( not $eval_ok or @warnings ) { 4122 Marpa::Internal::code_problems( 4123 { fatal_error => $fatal_error, 4124 grammar => $grammar, 4125 eval_ok => $eval_ok, 4126 warnings => \@warnings, 4127 where => 'constructing action object', 4128 } 4129 ); 4130 } ## end if ( not $eval_ok or @warnings ) 4131 } ## end if ($action_object_constructor) 4132 4133 $action_object //= {}; 4134 4135 return Marpa::Internal::Evaluator::evaluate( $grammar, 4136 $action_object, \@preorder, 4137 $evaler->[Marpa::Internal::Evaluator::TRACE_VALUES] ); 4138 4139 } ## end when (Marpa::Internal::Task::EVALUATE) 4140 ## End EVALUATE 4141 4142 default { 4143 Carp::confess("Internal error: Unknown task, number $task"); 4144 } 4145 } ## end given 4146 4147 } ## end while 4148 4149 Carp::confess('Internal error: Should not reach here'); 4150 4151} ## end sub Marpa::Evaluator::value 4152 41531; 4154