1# 2# Module Parse::Yapp::Lalr 3# 4# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved. 5# (see the pod text in Parse::Yapp module for use and distribution rights) 6# 7package Parse::Yapp::Lalr; 8@ISA=qw( Parse::Yapp::Grammar ); 9 10require 5.004; 11 12use Parse::Yapp::Grammar; 13 14=for nobody 15 16Parse::Yapp::Compile Object Structure: 17-------------------------------------- 18{ 19 GRAMMAR => Parse::Yapp::Grammar, 20 STATES => [ { CORE => [ items... ], 21 ACTIONS => { term => action } 22 GOTOS => { nterm => stateno } 23 }... ] 24 CONFLICTS=>{ SOLVED => { stateno => [ ruleno, token, solved ] }, 25 FORCED => { TOTAL => [ nbsr, nbrr ], 26 DETAIL => { stateno => { TOTAL => [ nbsr, nbrr ] } 27 LIST => [ ruleno, token ] 28 } 29 } 30 } 31} 32 33'items' are of form: [ ruleno, dotpos ] 34'term' in ACTIONS is '' means default action 35'action' may be: 36 undef: explicit error (nonassociativity) 37 0 : accept 38 >0 : shift and go to state 'action' 39 <0 : reduce using rule -'action' 40'solved' may have values of: 41 'shift' if solved as Shift 42 'reduce' if solved as Reduce 43 'error' if solved by discarding both Shift and Reduce (nonassoc) 44 45SOLVED is a set of states containing Solved conflicts 46FORCED are forced conflict resolutions 47 48nbsr and nbrr are number of shift/reduce and reduce/reduce conflicts 49 50TOTAL is the total number of SR/RR conflicts for the parser 51 52DETAIL is the detail of conflicts for each state 53TOTAL is the total number of SR/RR conflicts for a state 54LIST is the list of discarded reductions (for display purpose only) 55 56 57=cut 58 59use strict; 60 61use Carp; 62 63############### 64# Constructor # 65############### 66sub new { 67 my($class)=shift; 68 69 ref($class) 70 and $class=ref($class); 71 72 my($self)=$class->SUPER::new(@_); 73 $self->_Compile(); 74 bless($self,$class); 75} 76########### 77# Methods # 78########### 79 80########################### 81# Method To View Warnings # 82########################### 83sub Warnings { 84 my($self)=shift; 85 my($text); 86 my($nbsr,$nbrr)=@{$$self{CONFLICTS}{FORCED}{TOTAL}}; 87 88 $text=$self->SUPER::Warnings(); 89 90 $nbsr != $$self{GRAMMAR}{EXPECT} 91 and $text.="$nbsr shift/reduce conflict".($nbsr > 1 ? "s" : ""); 92 93 $nbrr 94 and do { 95 $nbsr 96 and $text.=" and "; 97 $text.="$nbrr reduce/reduce conflict".($nbrr > 1 ? "s" : ""); 98 }; 99 100 ( $nbsr != $$self{GRAMMAR}{EXPECT} 101 or $nbrr) 102 and $text.="\n"; 103 104 $text; 105} 106############################# 107# Method To View DFA States # 108############################# 109sub ShowDfa { 110 my($self)=shift; 111 my($text); 112 my($grammar,$states)=($$self{GRAMMAR}, $$self{STATES}); 113 114 for my $stateno (0..$#$states) { 115 my(@shifts,@reduces,@errors,$default); 116 117 $text.="State $stateno:\n\n"; 118 119 #Dump Kernel Items 120 for (sort { $$a[0] <=> $$b[0] 121 or $$a[1] <=> $$b[1] } @{$$states[$stateno]{'CORE'}}) { 122 my($ruleno,$pos)=@$_; 123 my($lhs,$rhs)=@{$$grammar{RULES}[$ruleno]}[0,1]; 124 my(@rhscopy)=@$rhs; 125 126 $ruleno 127 or $rhscopy[-1] = '$end'; 128 129 splice(@rhscopy,$pos,0,'.'); 130 $text.= "\t$lhs -> ".join(' ',@rhscopy)."\t(Rule $ruleno)\n"; 131 } 132 133 #Prepare Actions 134 for (keys(%{$$states[$stateno]{ACTIONS}})) { 135 my($term,$action)=($_,$$states[$stateno]{ACTIONS}{$_}); 136 137 $term eq chr(0) 138 and $term = '$end'; 139 140 not defined($action) 141 and do { 142 push(@errors,$term); 143 next; 144 }; 145 146 $action > 0 147 and do { 148 push(@shifts,[ $term, $action ]); 149 next; 150 }; 151 152 $action = -$action; 153 154 $term 155 or do { 156 $default= [ '$default', $action ]; 157 next; 158 }; 159 160 push(@reduces,[ $term, $action ]); 161 } 162 163 #Dump shifts 164 @shifts 165 and do { 166 $text.="\n"; 167 for (sort { $$a[0] cmp $$b[0] } @shifts) { 168 my($term,$shift)=@$_; 169 170 $text.="\t$term\tshift, and go to state $shift\n"; 171 } 172 }; 173 174 #Dump errors 175 @errors 176 and do { 177 $text.="\n"; 178 for my $term (sort { $a cmp $b } @errors) { 179 $text.="\t$term\terror (nonassociative)\n"; 180 } 181 }; 182 183 #Prepare reduces 184 exists($$self{CONFLICTS}{FORCED}{DETAIL}{$stateno}) 185 and push(@reduces,@{$$self{CONFLICTS}{FORCED}{DETAIL}{$stateno}{LIST}}); 186 187 @reduces=sort { $$a[0] cmp $$b[0] or $$a[1] <=> $$b[1] } @reduces; 188 189 defined($default) 190 and push(@reduces,$default); 191 192 #Dump reduces 193 @reduces 194 and do { 195 $text.="\n"; 196 for (@reduces) { 197 my($term,$ruleno)=@$_; 198 my($discard); 199 200 $ruleno < 0 201 and do { 202 ++$discard; 203 $ruleno = -$ruleno; 204 }; 205 206 $text.= "\t$term\t".($discard ? "[" : ""); 207 if($ruleno) { 208 $text.= "reduce using rule $ruleno ". 209 "($$grammar{RULES}[$ruleno][0])"; 210 } 211 else { 212 $text.='accept'; 213 } 214 $text.=($discard ? "]" : "")."\n"; 215 } 216 }; 217 218 #Dump gotos 219 exists($$states[$stateno]{GOTOS}) 220 and do { 221 $text.= "\n"; 222 for (keys(%{$$states[$stateno]{GOTOS}})) { 223 $text.= "\t$_\tgo to state $$states[$stateno]{GOTOS}{$_}\n"; 224 } 225 }; 226 227 $text.="\n"; 228 } 229 $text; 230} 231 232###################################### 233# Method to get summary about parser # 234###################################### 235sub Summary { 236 my($self)=shift; 237 my($text); 238 239 $text=$self->SUPER::Summary(); 240 $text.="Number of states : ". 241 scalar(@{$$self{STATES}})."\n"; 242 $text; 243} 244 245####################################### 246# Method To Get Infos about conflicts # 247####################################### 248sub Conflicts { 249 my($self)=shift; 250 my($states)=$$self{STATES}; 251 my($conflicts)=$$self{CONFLICTS}; 252 my($text); 253 254 for my $stateno ( sort { $a <=> $b } keys(%{$$conflicts{SOLVED}})) { 255 256 for (@{$$conflicts{SOLVED}{$stateno}}) { 257 my($ruleno,$token,$how)=@$_; 258 259 $token eq chr(0) 260 and $token = '$end'; 261 262 $text.="Conflict in state $stateno between rule ". 263 "$ruleno and token $token resolved as $how.\n"; 264 } 265 }; 266 267 for my $stateno ( sort { $a <=> $b } keys(%{$$conflicts{FORCED}{DETAIL}})) { 268 my($nbsr,$nbrr)=@{$$conflicts{FORCED}{DETAIL}{$stateno}{TOTAL}}; 269 270 $text.="State $stateno contains "; 271 272 $nbsr 273 and $text.="$nbsr shift/reduce conflict". 274 ($nbsr > 1 ? "s" : ""); 275 276 $nbrr 277 and do { 278 $nbsr 279 and $text.=" and "; 280 281 $text.="$nbrr reduce/reduce conflict". 282 ($nbrr > 1 ? "s" : ""); 283 }; 284 $text.="\n"; 285 }; 286 287 $text; 288} 289 290################################# 291# Method to dump parsing tables # 292################################# 293sub DfaTable { 294 my($self)=shift; 295 my($states)=$$self{STATES}; 296 my($stateno); 297 my($text); 298 299 $text="[\n\t{"; 300 301 $text.=join("\n\t},\n\t{", 302 map { 303 my($state)=$_; 304 my($text); 305 306 $text="#State ".$stateno++."\n\t\t"; 307 308 ( not exists($$state{ACTIONS}{''}) 309 or keys(%{$$state{ACTIONS}}) > 1) 310 and do { 311 312 $text.="ACTIONS => {\n\t\t\t"; 313 314 $text.=join(",\n\t\t\t", 315 map { 316 my($term,$action)=($_,$$state{ACTIONS}{$_}); 317 my($text); 318 319 if(substr($term,0,1) eq "'") { 320 $term=~s/([\@\$\"])/\\$1/g; 321 $term=~s/^'|'$/"/g; 322 } 323 else { 324 $term= $term eq chr(0) 325 ? "''" 326 : "'$term'"; 327 } 328 329 if(defined($action)) { 330 $action=int($action); 331 } 332 else { 333 $action='undef'; 334 } 335 336 "$term => $action"; 337 338 } grep { $_ } keys(%{$$state{ACTIONS}})); 339 340 $text.="\n\t\t}"; 341 }; 342 343 exists($$state{ACTIONS}{''}) 344 and do { 345 keys(%{$$state{ACTIONS}}) > 1 346 and $text.=",\n\t\t"; 347 348 $text.="DEFAULT => $$state{ACTIONS}{''}"; 349 }; 350 351 exists($$state{GOTOS}) 352 and do { 353 $text.=",\n\t\tGOTOS => {\n\t\t\t"; 354 $text.=join(",\n\t\t\t", 355 map { 356 my($nterm,$stateno)=($_,$$state{GOTOS}{$_}); 357 my($text); 358 359 "'$nterm' => $stateno"; 360 361 } keys(%{$$state{GOTOS}})); 362 $text.="\n\t\t}"; 363 }; 364 365 $text; 366 367 }@$states); 368 369 $text.="\n\t}\n]"; 370 371 $text; 372 373} 374 375 376#################################### 377# Method to build Dfa from Grammar # 378#################################### 379sub _Compile { 380 my($self)=shift; 381 my($grammar,$states); 382 383 $grammar=$self->{GRAMMAR}; 384 385 $states = _LR0($grammar); 386 387 $self->{CONFLICTS} = _LALR($grammar,$states); 388 389 $self->{STATES}=$states; 390} 391 392######################### 393# LR0 States Generation # 394######################### 395# 396########################### 397# General digraph routine # 398########################### 399sub _Digraph { 400 my($rel,$F)=@_; 401 my(%N,@S); 402 my($infinity)=(~(1<<31)); 403 my($Traverse); 404 405 $Traverse = sub { 406 my($x,$d)=@_; 407 my($y); 408 409 push(@S,$x); 410 $N{$x}=$d; 411 412 exists($$rel{$x}) 413 and do { 414 for $y (keys(%{$$rel{$x}})) { 415 exists($N{$y}) 416 or &$Traverse($y,$d+1); 417 418 $N{$y} < $N{$x} 419 and $N{$x} = $N{$y}; 420 421 $$F{$x}|=$$F{$y}; 422 } 423 }; 424 425 $N{$x} == $d 426 and do { 427 for(;;) { 428 $y=pop(@S); 429 $N{$y}=$infinity; 430 $y eq $x 431 and last; 432 $$F{$y}=$$F{$x}; 433 } 434 }; 435 }; 436 437 for (keys(%$rel)) { 438 exists($N{$_}) 439 or &$Traverse($_,1); 440 } 441} 442####################### 443# Generate LR0 states # 444####################### 445=for nobody 446Formula used for closures: 447 448 CLOSE(A) = DCLOSE(A) u U (CLOSE(B) | A close B) 449 450where: 451 452 DCLOSE(A) = { [ A -> alpha ] in P } 453 454 A close B iff [ A -> B gamma ] in P 455 456=cut 457sub _SetClosures { 458 my($grammar)=@_; 459 my($rel,$closures); 460 461 for my $symbol (keys(%{$$grammar{NTERM}})) { 462 $closures->{$symbol}=pack('b'.@{$$grammar{RULES}}); 463 464 for my $ruleno (@{$$grammar{NTERM}{$symbol}}) { 465 my($rhs)=$$grammar{RULES}[$ruleno][1]; 466 467 vec($closures->{$symbol},$ruleno,1)=1; 468 469 @$rhs > 0 470 and exists($$grammar{NTERM}{$$rhs[0]}) 471 and ++$rel->{$symbol}{$$rhs[0]}; 472 } 473 } 474 _Digraph($rel,$closures); 475 476 $closures 477} 478 479sub _Closures { 480 my($grammar,$core,$closures)=@_; 481 my($ruleset)=pack('b'.@{$$grammar{RULES}}); 482 483 for (@$core) { 484 my($ruleno,$pos)=@$_; 485 my($rhs)=$$grammar{RULES}[$ruleno][1]; 486 487 $pos < @$rhs 488 and exists($closures->{$$rhs[$pos]}) 489 and $ruleset|=$closures->{$$rhs[$pos]}; 490 } 491 [ @$core, map { [ $_, 0 ] } 492 grep { vec($ruleset,$_,1) } 493 0..$#{$$grammar{RULES}} ]; 494} 495 496sub _Transitions { 497 my($grammar,$cores,$closures,$states,$stateno)=@_; 498 my($core)=$$states[$stateno]{'CORE'}; 499 my(%transitions); 500 501 for (@{_Closures($grammar,$core,$closures)}) { 502 my($ruleno,$pos)=@$_; 503 my($rhs)=$$grammar{RULES}[$ruleno][1]; 504 505 $pos == @$rhs 506 and do { 507 push(@{$$states[$stateno]{ACTIONS}{''}},$ruleno); 508 next; 509 }; 510 push(@{$transitions{$$rhs[$pos]}},[ $ruleno, $pos+1 ]); 511 } 512 513 for (keys(%transitions)) { 514 my($symbol,$core)=($_,$transitions{$_}); 515 my($corekey)=join(',',map { join('.',@$_) } 516 sort { $$a[0] <=> $$b[0] 517 or $$a[1] <=> $$b[1] } 518 @$core); 519 my($tostateno); 520 521 exists($cores->{$corekey}) 522 or do { 523 push(@$states,{ 'CORE' => $core }); 524 $cores->{$corekey}=$#$states; 525 }; 526 527 $tostateno=$cores->{$corekey}; 528 push(@{$$states[$tostateno]{FROM}},$stateno); 529 530 exists($$grammar{TERM}{$_}) 531 and do { 532 $$states[$stateno]{ACTIONS}{$_} = [ $tostateno ]; 533 next; 534 }; 535 $$states[$stateno]{GOTOS}{$_} = $tostateno; 536 } 537} 538 539sub _LR0 { 540 my($grammar)=@_; 541 my($states) = []; 542 my($stateno); 543 my($closures); #$closures={ nterm => ruleset,... } 544 my($cores)={}; # { "itemlist" => stateno, ... } 545 # where "itemlist" has the form: 546 # "ruleno.pos,ruleno.pos" ordered by ruleno,pos 547 548 $closures = _SetClosures($grammar); 549 push(@$states,{ 'CORE' => [ [ 0, 0 ] ] }); 550 for($stateno=0;$stateno<@$states;++$stateno) { 551 _Transitions($grammar,$cores,$closures,$states,$stateno); 552 } 553 554 $states 555} 556 557######################################################### 558# Add Lookahead tokens where needed to make LALR states # 559######################################################### 560=for nobody 561 Compute First sets for non-terminal using the following formula: 562 563 FIRST(A) = { a in T u { epsilon } | A l a } 564 u 565 U { FIRST(B) | B in V and A l B } 566 567 where: 568 569 A l x iff [ A -> X1 X2 .. Xn x alpha ] in P and Xi =>* epsilon, 1 <= i <= n 570=cut 571sub _SetFirst { 572 my($grammar,$termlst,$terminx)=@_; 573 my($rel,$first)=( {}, {} ); 574 575 for my $symbol (keys(%{$$grammar{NTERM}})) { 576 $first->{$symbol}=pack('b'.@$termlst); 577 578 RULE: 579 for my $ruleno (@{$$grammar{NTERM}{$symbol}}) { 580 my($rhs)=$$grammar{RULES}[$ruleno][1]; 581 582 for (@$rhs) { 583 exists($terminx->{$_}) 584 and do { 585 vec($first->{$symbol},$terminx->{$_},1)=1; 586 next RULE; 587 }; 588 ++$rel->{$symbol}{$_}; 589 exists($$grammar{NULLABLE}{$_}) 590 or next RULE; 591 } 592 vec($first->{$symbol},0,1)=1; 593 } 594 } 595 _Digraph($rel,$first); 596 597 $first 598} 599 600sub _Preds { 601 my($states,$stateno,$len)=@_; 602 my($queue, $preds); 603 604 $len 605 or return [ $stateno ]; 606 607 $queue=[ [ $stateno, $len ] ]; 608 while(@$queue) { 609 my($pred) = shift(@$queue); 610 my($stateno, $len) = @$pred; 611 612 $len == 1 613 and do { 614 push(@$preds,@{$states->[$stateno]{FROM}}); 615 next; 616 }; 617 618 push(@$queue, map { [ $_, $len - 1 ] } 619 @{$states->[$stateno]{FROM}}); 620 } 621 622 # Pass @$preds through a hash to ensure unicity 623 [ keys( %{ +{ map { ($_,1) } @$preds } } ) ]; 624} 625 626sub _FirstSfx { 627 my($grammar,$firstset,$termlst,$terminx,$ruleno,$pos,$key)=@_; 628 my($first)=pack('b'.@$termlst); 629 my($rhs)=$$grammar{RULES}[$ruleno][1]; 630 631 for (;$pos < @$rhs;++$pos) { 632 exists($terminx->{$$rhs[$pos]}) 633 and do { 634 vec($first,$terminx->{$$rhs[$pos]},1)=1; 635 return($first); 636 }; 637 $first|=$firstset->{$$rhs[$pos]}; 638 639 vec($first,0,1) 640 and vec($first,0,1)=0; 641 642 exists($$grammar{NULLABLE}{$$rhs[$pos]}) 643 or return($first); 644 645 } 646 vec($first,0,1)=1; 647 $first; 648} 649 650=for noboby 651 Compute Follow sets using following formula: 652 653 FOLLOW(p,A) = READ(p,A) 654 u 655 U { FOLLOW(q,B) | (p,A) include (q,B) 656 657 where: 658 659 READ(p,A) = U { FIRST(beta) | [ A -> alpha A . beta ] in KERNEL(GOTO(p,A)) 660 } - { epsilon } 661 662 (p,a) include (q,B) iff [ B -> alpha A . beta ] in KERNEL(GOTO(p,A), 663 epsilon in FIRST(beta) and 664 q in PRED(p,alpha) 665=cut 666sub _ComputeFollows { 667 my($grammar,$states,$termlst)=@_; 668 my($firstset,$terminx); 669 my($inconsistent, $rel, $follows, $sfx)= ( {}, {}, {}, {} ); 670 671 %$terminx= map { ($termlst->[$_],$_) } 0..$#$termlst; 672 673 $firstset=_SetFirst($grammar,$termlst,$terminx); 674 675 for my $stateno (0..$#$states) { 676 my($state)=$$states[$stateno]; 677 678 exists($$state{ACTIONS}{''}) 679 and ( @{$$state{ACTIONS}{''}} > 1 680 or keys(%{$$state{ACTIONS}}) > 1 ) 681 and do { 682 ++$inconsistent->{$stateno}; 683 684 for my $ruleno (@{$$state{ACTIONS}{''}}) { 685 my($lhs,$rhs)=@{$$grammar{RULES}[$ruleno]}[0,1]; 686 687 for my $predno (@{_Preds($states,$stateno,scalar(@$rhs))}) { 688 ++$rel->{"$stateno.$ruleno"}{"$predno.$lhs"}; 689 } 690 } 691 }; 692 693 exists($$state{GOTOS}) 694 or next; 695 696 for my $symbol (keys(%{$$state{GOTOS}})) { 697 my($tostate)=$$states[$$state{GOTOS}{$symbol}]; 698 my($goto)="$stateno.$symbol"; 699 700 $follows->{$goto}=pack('b'.@$termlst); 701 702 for my $item (@{$$tostate{'CORE'}}) { 703 my($ruleno,$pos)=@$item; 704 my($key)="$ruleno.$pos"; 705 706 exists($sfx->{$key}) 707 or $sfx->{$key} = _FirstSfx($grammar,$firstset, 708 $termlst,$terminx, 709 $ruleno,$pos,$key); 710 711 $follows->{$goto}|=$sfx->{$key}; 712 713 vec($follows->{$goto},0,1) 714 and do { 715 my($lhs)=$$grammar{RULES}[$ruleno][0]; 716 717 vec($follows->{$goto},0,1)=0; 718 719 for my $predno (@{_Preds($states,$stateno,$pos-1)}) { 720 ++$rel->{$goto}{"$predno.$lhs"}; 721 } 722 }; 723 } 724 } 725 } 726 _Digraph($rel,$follows); 727 728 ($follows,$inconsistent) 729} 730 731sub _ComputeLA { 732 my($grammar,$states)=@_; 733 my($termlst)= [ '',keys(%{$$grammar{TERM}}) ]; 734 735 my($follows,$inconsistent) = _ComputeFollows($grammar,$states,$termlst); 736 737 for my $stateno ( keys(%$inconsistent ) ) { 738 my($state)=$$states[$stateno]; 739 my($conflict); 740 741 #NB the sort is VERY important for conflicts resolution order 742 for my $ruleno (sort { $a <=> $b } 743 @{$$state{ACTIONS}{''}}) { 744 for my $term ( map { $termlst->[$_] } grep { 745 vec($follows->{"$stateno.$ruleno"},$_,1) } 746 0..$#$termlst) { 747 exists($$state{ACTIONS}{$term}) 748 and ++$conflict; 749 push(@{$$state{ACTIONS}{$term}},-$ruleno); 750 } 751 } 752 delete($$state{ACTIONS}{''}); 753 $conflict 754 or delete($inconsistent->{$stateno}); 755 } 756 757 $inconsistent 758} 759 760############################# 761# Solve remaining conflicts # 762############################# 763 764sub _SolveConflicts { 765 my($grammar,$states,$inconsistent)=@_; 766 my(%rulesprec,$RulePrec); 767 my($conflicts)={ SOLVED => {}, 768 FORCED => { TOTAL => [ 0, 0 ], 769 DETAIL => {} 770 } 771 }; 772 773 $RulePrec = sub { 774 my($ruleno)=@_; 775 my($rhs,$rprec)=@{$$grammar{RULES}[$ruleno]}[1,2]; 776 my($lastterm); 777 778 defined($rprec) 779 and return($rprec); 780 781 exists($rulesprec{$ruleno}) 782 and return($rulesprec{$ruleno}); 783 784 $lastterm=(grep { exists($$grammar{TERM}{$_}) } @$rhs)[-1]; 785 786 defined($lastterm) 787 and ref($$grammar{TERM}{$lastterm}) 788 and do { 789 $rulesprec{$ruleno}=$$grammar{TERM}{$lastterm}[1]; 790 return($rulesprec{$ruleno}); 791 }; 792 793 undef; 794 }; 795 796 for my $stateno (keys(%$inconsistent)) { 797 my($state)=$$states[$stateno]; 798 my($actions)=$$state{ACTIONS}; 799 my($nbsr,$nbrr); 800 801 for my $term ( keys(%$actions) ) { 802 my($act)=$$actions{$term}; 803 804 @$act > 1 805 or next; 806 807 $$act[0] > 0 808 and ref($$grammar{TERM}{$term}) 809 and do { 810 my($assoc,$tprec)=@{$$grammar{TERM}{$term}}; 811 my($k,$error); 812 813 for ($k=1;$k<@$act;++$k) { 814 my($ruleno)=-$$act[$k]; 815 my($rprec)=&$RulePrec($ruleno); 816 817 defined($rprec) 818 or next; 819 820 ( $tprec > $rprec 821 or ( $tprec == $rprec and $assoc eq 'RIGHT')) 822 and do { 823 push(@{$$conflicts{SOLVED}{$stateno}}, 824 [ $ruleno, $term, 'shift' ]); 825 splice(@$act,$k--,1); 826 next; 827 }; 828 ( $tprec < $rprec 829 or $assoc eq 'LEFT') 830 and do { 831 push(@{$$conflicts{SOLVED}{$stateno}}, 832 [ $ruleno, $term, 'reduce' ]); 833 $$act[0] > 0 834 and do { 835 splice(@$act,0,1); 836 --$k; 837 }; 838 next; 839 }; 840 push(@{$$conflicts{SOLVED}{$stateno}}, 841 [ $ruleno, $term, 'error' ]); 842 splice(@$act,$k--,1); 843 $$act[0] > 0 844 and do { 845 splice(@$act,0,1); 846 ++$error; 847 --$k; 848 }; 849 } 850 $error 851 and unshift(@$act,undef); 852 }; 853 854 @$act > 1 855 and do { 856 $nbrr += @$act - 2; 857 ($$act[0] > 0 ? $nbsr : $nbrr) += 1; 858 push(@{$$conflicts{FORCED}{DETAIL}{$stateno}{LIST}}, 859 map { [ $term, $_ ] } splice(@$act,1)); 860 }; 861 } 862 863 $nbsr 864 and do { 865 $$conflicts{FORCED}{TOTAL}[0]+=$nbsr; 866 $$conflicts{FORCED}{DETAIL}{$stateno}{TOTAL}[0]+=$nbsr; 867 }; 868 869 $nbrr 870 and do { 871 $$conflicts{FORCED}{TOTAL}[1]+=$nbrr; 872 $$conflicts{FORCED}{DETAIL}{$stateno}{TOTAL}[1]+=$nbrr; 873 }; 874 875 } 876 877 $conflicts 878} 879 880############################### 881# Make default reduce actions # 882############################### 883sub _SetDefaults { 884 my($states)=@_; 885 886 for my $state (@$states) { 887 my($actions)=$$state{ACTIONS}; 888 my(%reduces,$default,$nodefault); 889 890 exists($$actions{''}) 891 and do { 892 $$actions{''}[0] = -$$actions{''}[0]; 893 ++$nodefault; 894 }; 895 896 #shift error token => no default 897 exists($$actions{error}) 898 and $$actions{error}[0] > 0 899 and ++$nodefault; 900 901 for my $term (keys(%$actions)) { 902 903 $$actions{$term}=$$actions{$term}[0]; 904 905 ( not defined($$actions{$term}) 906 or $$actions{$term} > 0 907 or $nodefault) 908 and next; 909 910 push(@{$reduces{$$actions{$term}}},$term); 911 } 912 913 keys(%reduces) > 0 914 or next; 915 916 $default=( map { $$_[0] } 917 sort { $$b[1] <=> $$a[1] or $$b[0] <=> $$a[0] } 918 map { [ $_, scalar(@{$reduces{$_}}) ] } 919 keys(%reduces))[0]; 920 921 delete(@$actions{ @{$reduces{$default}} }); 922 $$state{ACTIONS}{''}=$default; 923 } 924} 925 926sub _LALR { 927 my($grammar,$states) = @_; 928 my($conflicts,$inconsistent); 929 930 $inconsistent = _ComputeLA($grammar,$states); 931 932 $conflicts = _SolveConflicts($grammar,$states,$inconsistent); 933 _SetDefaults($states); 934 935 $conflicts 936} 937 938 9391; 940