Parse::Yapp::Compile Object Structure:
--------------------------------------
{
GRAMMAR => Parse::Yapp::Grammar,
STATES => [ { CORE => [ items... ],
ACTIONS => { term => action }
GOTOS => { nterm => stateno }
}... ]
CONFLICTS=>{ SOLVED => { stateno => [ ruleno, token, solved ] },
FORCED => { TOTAL => [ nbsr, nbrr ],
DETAIL => { stateno => { TOTAL => [ nbsr, nbrr ] }
LIST => [ ruleno, token ]
}
}
}
}
'items' are of form: [ ruleno, dotpos ]
'term' in ACTIONS is '' means default action
'action' may be:
undef: explicit error (nonassociativity)
0 : accept
>0 : shift and go to state 'action'
<0 : reduce using rule -'action'
'solved' may have values of:
'shift' if solved as Shift
'reduce' if solved as Reduce
'error' if solved by discarding both Shift and Reduce (nonassoc)
SOLVED is a set of states containing Solved conflicts
FORCED are forced conflict resolutions
nbsr and nbrr are number of shift/reduce and reduce/reduce conflicts
TOTAL is the total number of SR/RR conflicts for the parser
DETAIL is the detail of conflicts for each state
TOTAL is the total number of SR/RR conflicts for a state
LIST is the list of discarded reductions (for display purpose only)
FOLLOW(p,A) = READ(p,A)
u
U { FOLLOW(q,B) | (p,A) include (q,B)
where:
READ(p,A) = U { FIRST(beta) | [ A -> alpha A . beta ] in KERNEL(GOTO(p,A))
} - { epsilon }
(p,a) include (q,B) iff [ B -> alpha A . beta ] in KERNEL(GOTO(p,A),
epsilon in FIRST(beta) and
q in PRED(p,alpha)
=cut
sub _ComputeFollows {
my($grammar,$states,$termlst)=@_;
my($firstset,$terminx);
my($inconsistent, $rel, $follows, $sfx)= ( {}, {}, {}, {} );
%$terminx= map { ($termlst->[$_],$_) } 0..$#$termlst;
$firstset=_SetFirst($grammar,$termlst,$terminx);
for my $stateno (0..$#$states) {
my($state)=$$states[$stateno];
exists($$state{ACTIONS}{''})
and ( @{$$state{ACTIONS}{''}} > 1
or keys(%{$$state{ACTIONS}}) > 1 )
and do {
++$inconsistent->{$stateno};
for my $ruleno (@{$$state{ACTIONS}{''}}) {
my($lhs,$rhs)=@{$$grammar{RULES}[$ruleno]}[0,1];
for my $predno (@{_Preds($states,$stateno,scalar(@$rhs))}) {
++$rel->{"$stateno.$ruleno"}{"$predno.$lhs"};
}
}
};
exists($$state{GOTOS})
or next;
for my $symbol (keys(%{$$state{GOTOS}})) {
my($tostate)=$$states[$$state{GOTOS}{$symbol}];
my($goto)="$stateno.$symbol";
$follows->{$goto}=pack('b'.@$termlst);
for my $item (@{$$tostate{'CORE'}}) {
my($ruleno,$pos)=@$item;
my($key)="$ruleno.$pos";
exists($sfx->{$key})
or $sfx->{$key} = _FirstSfx($grammar,$firstset,
$termlst,$terminx,
$ruleno,$pos,$key);
$follows->{$goto}|=$sfx->{$key};
vec($follows->{$goto},0,1)
and do {
my($lhs)=$$grammar{RULES}[$ruleno][0];
vec($follows->{$goto},0,1)=0;
for my $predno (@{_Preds($states,$stateno,$pos-1)}) {
++$rel->{$goto}{"$predno.$lhs"};
}
};
}
}
}
_Digraph($rel,$follows);
($follows,$inconsistent)
}
| sub _ComputeLA {
|
| my($grammar,$states)=@_;
|
| my($termlst)= [ '',keys(%{$$grammar{TERM}}) ]; |
my($follows,$inconsistent) = _ComputeFollows($grammar,$states,$termlst);
for my $stateno ( keys(%$inconsistent ) ) {
my($state)=$$states[$stateno];
my($conflict);
#NB the sort is VERY important for conflicts resolution order
for my $ruleno (sort { $a <=> $b }
@{$$state{ACTIONS}{''}}) {
for my $term ( map { $termlst->[$_] } grep {
vec($follows->{"$stateno.$ruleno"},$_,1) }
0..$#$termlst) {
exists($$state{ACTIONS}{$term})
and ++$conflict;
push(@{$$state{ACTIONS}{$term}},-$ruleno);
}
}
delete($$state{ACTIONS}{''});
$conflict
or delete($inconsistent->{$stateno});
}
$inconsistent
}
#############################
# Solve remaining conflicts #
#############################
sub _SolveConflicts {
my($grammar,$states,$inconsistent)=@_;
my(%rulesprec,$RulePrec);
my($conflicts)={ SOLVED => {},
FORCED => { TOTAL => [ 0, 0 ],
DETAIL => {}
}
};
$RulePrec = sub {
my($ruleno)=@_;
my($rhs,$rprec)=@{$$grammar{RULES}[$ruleno]}[1,2];
my($lastterm);
defined($rprec)
and return($rprec);
exists($rulesprec{$ruleno})
and return($rulesprec{$ruleno});
$lastterm=(grep { exists($$grammar{TERM}{$_}) } @$rhs)[-1];
defined($lastterm)
and ref($$grammar{TERM}{$lastterm})
and do {
$rulesprec{$ruleno}=$$grammar{TERM}{$lastterm}[1];
return($rulesprec{$ruleno});
};
undef;
};
for my $stateno (keys(%$inconsistent)) {
my($state)=$$states[$stateno];
my($actions)=$$state{ACTIONS};
my($nbsr,$nbrr);
for my $term ( keys(%$actions) ) {
my($act)=$$actions{$term};
@$act > 1
or next;
$$act[0] > 0
and ref($$grammar{TERM}{$term})
and do {
my($assoc,$tprec)=@{$$grammar{TERM}{$term}};
my($k,$error);
for ($k=1;$k<@$act;++$k) {
my($ruleno)=-$$act[$k];
my($rprec)=&$RulePrec($ruleno);
defined($rprec)
or next;
( $tprec > $rprec
or ( $tprec == $rprec and $assoc eq 'RIGHT'))
and do {
push(@{$$conflicts{SOLVED}{$stateno}},
[ $ruleno, $term, 'shift' ]);
splice(@$act,$k--,1);
next;
};
( $tprec < $rprec
or $assoc eq 'LEFT')
and do {
push(@{$$conflicts{SOLVED}{$stateno}},
[ $ruleno, $term, 'reduce' ]);
$$act[0] > 0
and do {
splice(@$act,0,1);
--$k;
};
next;
};
push(@{$$conflicts{SOLVED}{$stateno}},
[ $ruleno, $term, 'error' ]);
splice(@$act,$k--,1);
$$act[0] > 0
and do {
splice(@$act,0,1);
++$error;
--$k;
};
}
$error
and unshift(@$act,undef);
};
@$act > 1
and do {
$nbrr += @$act - 2;
($$act[0] > 0 ? $nbsr : $nbrr) += 1;
push(@{$$conflicts{FORCED}{DETAIL}{$stateno}{LIST}},
map { [ $term, $_ ] } splice(@$act,1));
};
}
$nbsr
and do {
$$conflicts{FORCED}{TOTAL}[0]+=$nbsr;
$$conflicts{FORCED}{DETAIL}{$stateno}{TOTAL}[0]+=$nbsr;
};
$nbrr
and do {
$$conflicts{FORCED}{TOTAL}[1]+=$nbrr;
$$conflicts{FORCED}{DETAIL}{$stateno}{TOTAL}[1]+=$nbrr;
};
}
$conflicts
}
###############################
# Make default reduce actions #
###############################
sub _SetDefaults {
my($states)=@_;
for my $state (@$states) {
my($actions)=$$state{ACTIONS};
my(%reduces,$default,$nodefault);
exists($$actions{''})
and do {
$$actions{''}[0] = -$$actions{''}[0];
++$nodefault;
};
#shift error token => no default
exists($$actions{error})
and $$actions{error}[0] > 0
and ++$nodefault;
for my $term (keys(%$actions)) {
$$actions{$term}=$$actions{$term}[0];
( not defined($$actions{$term})
or $$actions{$term} > 0
or $nodefault)
and next;
push(@{$reduces{$$actions{$term}}},$term);
}
keys(%reduces) > 0
or next;
$default=( map { $$_[0] }
sort { $$b[1] <=> $$a[1] or $$b[0] <=> $$a[0] }
map { [ $_, scalar(@{$reduces{$_}}) ] }
keys(%reduces))[0];
delete(@$actions{ @{$reduces{$default}} });
$$state{ACTIONS}{''}=$default;
}
}
| sub _LALR {
|
| my($grammar,$states) = @_;
|
| my($conflicts,$inconsistent); |
$inconsistent = _ComputeLA($grammar,$states);
$conflicts = _SolveConflicts($grammar,$states,$inconsistent);
_SetDefaults($states);
$conflicts
}
1;
