Programm zur nichtdeterminsitschen Bottom-Up-Analyse mit
backtracking
Ein wechselseitg rektursiver Algorithmus, in
Perl
programmiert. Die back-shift-Ausgaben sind z.T. etwas
irreführend, da auch bei misslungene shift eine "back"-Ausgabe
kommt.
#!/usr/local/bin/perl
# -*-perl-*- mode
#
# realisiere die bottom-Up-analyse mit Backtracking
#
# Eingabe: Grammatik Wort(e) auf stdin
# Ausgabe: Schritte
#
#
sub logmsg {
local($level,@rest) = @_;
$level<$verboselevel && print @rest;
}
#####################################
# eigentlicher Algorithmus
sub matchrule {
# prüfe, ob eine Regel (für Reduktion) anwendbar ist
local($rn,$left) = @_;
my $rright = substr($rules[$rn],4);
my $match = substr($left,-1*length($rright));
logmsg(4,"match: $match ($left) vs $rright (",length($rright),")\n");
return ( $match eq $rright );
}
sub applyrule {
# führe die Reduktion gemäß der Regel aus
local($rn,$left) = @_;
my $rright = substr($rules[$rn],4);
$left = substr($left,0,length($left)-length($rright));
$left .= substr($rules[$rn],0,1);
return $left;
}
sub reduce {
# ermittle rekursiv die Ableitung
local($left,$right) = @_;
my $rn;
logmsg(2,"($left,$right): ");
# versuche, ab rule $rulestart eine passende Regel zu finden
for ( $rn=0; $rn <= $#rules; $rn += 1 ) {
logmsg(3,"try: rule $rn (",$rules[$rn],")\n");
if ( matchrule($rn,$left) ) {
logmsg(2,"reduce, Regel $rn (",$rules[$rn],")\n");
reduce( applyrule($rn,$left), $right);
# wenn das zurückkehrt, ist backtracking gemeint
# - nächste Regel versuchen
logmsg(2,"back: Regel $rn\n");
};
};
# keine angemessene Regel mehr gefunden; shift:
wordshift($left,$right);
# wenn es hierher zurückkehrt, muß backtracking
# 1 Ebene höher versucht werden:
logmsg(2,"back: shift\n");
return;
}
sub wordshift {
local($left,$right) = @_;
#logmsg(2,"($left,$right): ");
# Ende prüfen ...
if ($right eq "" && $left eq "S") {
logmsg(1,"Wort $word in L(G)\n");
exit 0;
} elsif ($right eq "" && $left eq $word) {
logmsg(1,"Wort $word nicht in L(G)\n");
exit 0;
} elsif ($right eq "") {
return;
}
# ansonsten shift, und reduzieren ....
logmsg(2,"shift\n");
$left .= substr($right,0,1);
$right = substr($right,1);
reduce($left,$right);
}
######################## main
# Daten einlesen
$verboselevel=1;
while (<>) {
chomp;
/::=/ && ( push(@rules,$_), next );
/^-v/ && ( $verboselevel = length($_), next );
/^$/ || do {
# ein zu bearbeitendes Wort
$word = $_;
logmsg(2,"Regeln:\n ");
for ($i=0; $i<=$#rules;$i+=1) {
logmsg(2,"$i: ",$rules[$i],"\n ");
};
logmsg(1,"\nWort: $word\n\n");
# Start
wordshift("",$word);
# das darf nicht zurückkommen ?!
die ("Fehler: Fall kann nicht vorkommen\n");
}
}
