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