File Coverage

File:	blib/lib/Parse/Eyapp/Driver.pm
Coverage:	64.4%

line	stmt	bran	cond	sub	pod	time	code
1							#
2							# Module Parse::Eyapp::Driver
3							#
4							# This module is part of the Parse::Eyapp package available on your
5							# nearest CPAN
6							#
7							# This module is based on Francois Desarmenien Parse::Yapp module
8							# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
9							# (c) Copyright 2006 Casiano Rodriguez-Leon, all rights reserved.
10
11							package Parse::Eyapp::Driver;
12
13							require 5.004;
14
15	33 33 33			33		300 139 638	use strict;
16
17	33 33 33			33		2187 828 1918	use vars qw ( $VERSION $COMPATIBLE $FILENAME );
18
19							$VERSION = '1.06';
20							$COMPATIBLE = '0.07';
21							$FILENAME=__FILE__;
22
23	33 33 33			33		784 130 580	use Carp;
24
25							#Known parameters, all starting with YY (leading YY will be discarded)
26							my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
27							YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '',
28							# added by Casiano
29							YYPREFIX => '',
30							YYFILENAME => '',
31							YYGRAMMAR => 'ARRAY',
32							YYTERMS => 'HASH',
33							);
34							#Mandatory parameters
35							my(@params)=('LEX','RULES','STATES');
36
37							sub new {
38	54			54	0	10572	my($class)=shift;
39	54					317	my($errst,$nberr,$token,$value,$check,$dotpos);
40	54					1436	my($self)={ ERROR => \&_Error,
41							ERRST => \$errst,
42							NBERR => \$nberr,
43							TOKEN => \$token,
44							VALUE => \$value,
45							DOTPOS => \$dotpos,
46							STACK => [],
47							DEBUG => 0,
48							PREFIX => "",
49							CHECK => \$check };
50
51	54					636	_CheckParams( [], \%params, \@_, $self );
52
53	54	50	33			1702	exists($$self{VERSION})
54							and $$self{VERSION} < $COMPATIBLE
55							and croak "Yapp driver version $VERSION ".
56							"incompatible with version $$self{VERSION}:\n".
57							"Please recompile parser module.";
58
59	54	50				438	ref($class)
60							and $class=ref($class);
61
62	54					566	bless($self,$class);
63							}
64
65							sub YYParse {
66	64			64	0	935	my($self)=shift;
67	64					251	my($retval);
68
69	64					621	_CheckParams( \@params, \%params, \@_, $self );
70
71	64	50				587	if($$self{DEBUG}) {
72	0					0	_DBLoad();
73	0					0	$retval = eval '$self->_DBParse()';#Do not create stab entry on compile
74	0	0				0	$@ and die $@;
75							}
76							else {
77	64					1119	$retval = $self->_Parse();
78							}
79	64					551	return $retval;
80							}
81
82							sub YYData {
83	1023			1023	0	7007	my($self)=shift;
84
85	1023	100				6160	exists($$self{USER})
86							or $$self{USER}={};
87
88	1023					8206	$$self{USER};
89
90							}
91
92							sub YYErrok {
93	2			2	0	8	my($self)=shift;
94
95	2 2					7 11	${$$self{ERRST}}=0;
96	2					9	undef;
97							}
98
99							sub YYNberr {
100	1			1	0	5	my($self)=shift;
101
102	1 1					4 11	${$$self{NBERR}};
103							}
104
105							sub YYRecovering {
106	0			0	0	0	my($self)=shift;
107
108	0 0					0 0	${$$self{ERRST}} != 0;
109							}
110
111							sub YYAbort {
112	0			0	0	0	my($self)=shift;
113
114	0 0					0 0	${$$self{CHECK}}='ABORT';
115	0					0	undef;
116							}
117
118							sub YYAccept {
119	64			64	0	337	my($self)=shift;
120
121	64 64					270 452	${$$self{CHECK}}='ACCEPT';
122	64					296	undef;
123							}
124
125							sub YYError {
126	0			0	0	0	my($self)=shift;
127
128	0 0					0 0	${$$self{CHECK}}='ERROR';
129	0					0	undef;
130							}
131
132							sub YYSemval {
133	0			0	0	0	my($self)=shift;
134	0 0					0 0	my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
135
136	0					0	$index < 0
137	0	0	0			0	and -$index <= @{$$self{STACK}}
138							and return $$self{STACK}[$index][1];
139
140	0					0	undef; #Invalid index
141							}
142
143							### Casiano methods
144
145							sub YYLhs {
146							# returns the syntax variable on
147							# the left hand side of the current production
148	279			279	0	1078	my $self = shift;
149
150	279					1653	return $self->{CURRENT_LHS}
151							}
152
153							sub YYRuleindex {
154							# returns the index of the rule
155							# counting the super rule as rule 0
156	0			0	0	0	my $self = shift;
157
158	0					0	return $self->{CURRENT_RULE}
159							}
160
161							sub YYRightside {
162							# returns the rule
163							# counting the super rule as rule 0
164	511			511	0	1963	my $self = shift;
165
166	511 511					1574 5679	return @{$self->{GRAMMAR}->[$self->{CURRENT_RULE}]->[2]};
167							}
168
169							sub YYIsterm {
170	632			632	0	2452	my $self = shift;
171	632					2355	my $symbol = shift;
172
173	632					6575	return exists ($self->{TERMS}->{$symbol});
174							}
175
176							sub YYIssemantic {
177	671			671	0	2501	my $self = shift;
178	671					2490	my $symbol = shift;
179
180	671					5813	return ($self->{TERMS}->{$symbol});
181							}
182
183
184							sub YYName {
185	538			538	0	2041	my $self = shift;
186
187	538					4705	return $self->{GRAMMAR}->[$self->{CURRENT_RULE}]->[0];
188							}
189
190							sub YYPrefix {
191	705			705	0	2739	my $self = shift;
192
193	705	50				4188	$self->{PREFIX} = $_[0] if @_;
194							#$self->{PREFIX} .= '::' unless $self->{PREFIX} =~ /::$/;
195	705					5100	$self->{PREFIX};
196							}
197
198							sub YYFilename {
199	0			0	0	0	my $self = shift;
200
201	0	0				0	$self->{FILENAME} = $_[0] if @_;
202	0					0	$self->{FILENAME};
203							}
204
205							sub YYFirstline {
206	0			0	0	0	my $self = shift;
207
208	0	0				0	$self->{FIRSTLINE} = $_[0] if @_;
209	0					0	$self->{FIRSTLINE};
210							}
211
212							sub BeANode {
213	874			874	0	3417	my $class = shift;
214
215	33 33 33			33		562 153 398	no strict 'refs';
216	874 769	100				13475 11137	push @{$class."::ISA"}, "Parse::Eyapp::Node" unless $class->isa("Parse::Eyapp::Node");
217							}
218
219							sub BeATranslationScheme {
220	0			0	0	0	my $class = shift;
221
222	33 33 33			33		432 132 295	no strict 'refs';
223	0 0	0				0 0	push @{$class."::ISA"}, "Parse::Eyapp::TranslationScheme" unless $class->isa("Parse::Eyapp::TranslationScheme");
224							}
225
226							sub make_node_classes {
227	54			54	0	829	my $self = shift;
228	54		100			648	my $prefix = $self->YYPrefix() \|\| '';
229
230	54					363	for (@_) {
231	874					4763	BeANode("$prefix$_");
232							}
233							}
234
235							{
236
237							my %symbol_table = ();
238
239							sub YYBuildAST {
240	202			202	0	1125	my $self = shift;
241	202					1246	my $PREFIX = $self->YYPrefix();
242	202					1301	my @right = $self->YYRightside(); # Symbols on the right hand side of the production
243	202					1505	my $lhs = $self->YYLhs;
244	202					1194	my $name = $self->YYName();
245	202					606	my $class;
246	202					638	my @children;
247
248							for(my $i = 0; $i < @right; $i++) {
249	369					1459	$_ = $right[$i]; # The symbol
250	369					1546	my $ch = $_[$i]; # The attribute/reference
251	369	100				2009	if ($self->YYIssemantic($_)) {
252	161					646	$class = $PREFIX.'TERMINAL';
253	161					1961	my $node = bless { token => $_, attr => $ch, children => [] }, $class;
254	161					768	push @children, $node;
255	161 0	50				1366 0	push @{$symbol_table{$ch->id()}}, $node if UNIVERSAL::can($ch, 'id');
256	161					1309	next;
257							}
258	208	100				1335	next if $self->YYIsterm($_);
259
260	112	50				1941	if (UNIVERSAL::isa($ch, $PREFIX."_PAREN")) { # Warning: weak code!!!
261	0 0					0 0	push @children, @{$ch->{children}};
262	0					0	next;
263							}
264	112					1054	push @children, $ch;
265	202					746	}
266
267	202					761	$class = "$PREFIX$name";
268	202					1636	my $node = bless { children => \@children }, $class;
269	202					1182	$node;
270							}
271
272							sub YYGetSymbolTable {
273	0			0	0	0	my $node = shift;
274	0					0	return [$node, \%symbol_table];
275							}
276
277							} # end symboltable closure
278
279							sub YYBuildTS {
280	77			77	0	1611	my $self = shift;
281	77					465	my $PREFIX = $self->YYPrefix();
282	77					492	my @right = $self->YYRightside(); # Symbols on the right hand side of the production
283	77					479	my $lhs = $self->YYLhs;
284	77					422	my $name = $self->YYName();
285	77					245	my $class;
286	77					204	my @children;
287
288							for(my $i = 0; $i < @right; $i++) {
289	122					476	$_ = $right[$i]; # The symbol
290	122					498	my $ch = $_[$i]; # The attribute/reference
291
292	122	100				693	if ($self->YYIsterm($_)) {
293	57					234	$class = $PREFIX.'TERMINAL';
294	57					677	push @children, bless { token => $_, attr => $ch, children => [] }, $class;
295	57					487	next;
296							}
297
298	65	50				1063	if (UNIVERSAL::isa($ch, $PREFIX."_PAREN")) { # Warning: weak code!!!
299	0 0					0 0	push @children, @{$ch->{children}};
300	0					0	next;
301							}
302
303							# Substitute intermediate code node _CODE(CODE()) by CODE()
304	65	100				724	if (UNIVERSAL::isa($ch, $PREFIX."_CODE")) { # Warning: weak code!!!
305	10					91	push @children, $ch->child(0);
306	10					78	next;
307							}
308
309	55					485	push @children, $ch;
310	77					249	}
311
312	77	100				568	if (unpack('A1',$lhs) eq '@') { # class has to be _CODE check
313	10	50				99	$lhs =~ /^\@[0-9]+\-([0-9]+)$/
314							or croak "In line rule name '$lhs' ill formed: report it as a BUG.\n";
315	10					52	my $dotpos = $1;
316
317	10	50	33			221	croak "Fatal error building metatree when processing $lhs -> @right"
318							unless exists($_[$dotpos]) and UNIVERSAL::isa($_[$dotpos], 'CODE') ;
319	10					60	push @children, $_[$dotpos];
320							}
321							else {
322	67					343	push @children, $_[@right]; # metatree is on
323							}
324
325	77					311	$class = "$PREFIX$name";
326	77					587	my $node = bless { children => \@children }, $class;
327	77					489	$node;
328							}
329
330							# for lists
331							sub YYActionforT_TX1X2 {
332	113			113	0	640	my $self = shift;
333	113					476	my $head = shift;
334	113					638	my $PREFIX = $self->YYPrefix();
335	113					699	my @right = $self->YYRightside();
336	113					464	my $class;
337
338							for(my $i = 1; $i < @right; $i++) {
339	183					744	$_ = $right[$i];
340	183					906	my $ch = $_[$i-1];
341	183	50				1007	if ($self->YYIssemantic($_)) {
342	0					0	$class = $PREFIX.'TERMINAL';
343	0 0					0 0	push @{$head->{children}}, bless { token => $_, attr => $ch, children => [] }, $class;
344							#BeANode($class);
345	0					0	next;
346							}
347	183	100				1004	next if $self->YYIsterm($_);
348	113	50				972	if (ref($ch) eq $PREFIX."_PAREN") { # Warning: weak code!!!
349	0 0 0					0 0 0	push @{$head->{children}}, @{$ch->{children}};
350	0					0	next;
351							}
352	113 113					399 1198	push @{$head->{children}}, $ch;
353	113					400	}
354	113					634	return $head;
355							}
356
357							sub YYActionforT_empty {
358	140			140	0	761	my $self = shift;
359	140					898	my $PREFIX = $self->YYPrefix();
360	140					868	my $name = $self->YYName();
361
362							# Allow use of %name
363	140					685	my $class = $PREFIX.$name;
364	140					1305	my $node = bless { children => [] }, $class;
365							#BeANode($class);
366	140					658	$node;
367							}
368
369							sub YYActionforT_single {
370	119			119	0	638	my $self = shift;
371	119					672	my $PREFIX = $self->YYPrefix();
372	119					632	my $name = $self->YYName();
373	119					803	my @right = $self->YYRightside();
374	119					461	my $class;
375
376							# Allow use of %name
377	119					369	my @t;
378							for(my $i = 0; $i < @right; $i++) {
379	119					502	$_ = $right[$i];
380	119					513	my $ch = $_[$i];
381	119	50				727	if ($self->YYIssemantic($_)) {
382	0					0	$class = $PREFIX.'TERMINAL';
383	0					0	push @t, bless { token => $_, attr => $ch, children => [] }, $class;
384							#BeANode($class);
385	0					0	next;
386							}
387	119	50				746	next if $self->YYIsterm($_);
388	119	100				1057	if (ref($ch) eq $PREFIX."_PAREN") { # Warning: weak code!!!
389	45 45					189 285	push @t, @{$ch->{children}};
390	45					372	next;
391							}
392	74					720	push @t, $ch;
393	119					435	}
394	119					484	$class = $PREFIX.$name;
395	119					1019	my $node = bless { children => \@t }, $class;
396							#BeANode($class);
397	119					674	$node;
398							}
399
400							### end Casiano methods
401
402							sub YYCurtok {
403	0			0	0	0	my($self)=shift;
404
405							@_
406	0 0	0				0 0	and ${$$self{TOKEN}}=$_[0];
407	0 0					0 0	${$$self{TOKEN}};
408							}
409
410							sub YYCurval {
411	0			0	0	0	my($self)=shift;
412
413							@_
414	0 0	0				0 0	and ${$$self{VALUE}}=$_[0];
415	0 0					0 0	${$$self{VALUE}};
416							}
417
418							sub YYExpect {
419	0			0	0	0	my($self)=shift;
420
421	0 0					0 0	keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
422							}
423
424							sub YYLexer {
425	0			0	0	0	my($self)=shift;
426
427	0					0	$$self{LEX};
428							}
429
430
431							#################
432							# Private stuff #
433							#################
434
435
436							sub _CheckParams {
437	118			118		696	my($mandatory,$checklist,$inarray,$outhash)=@_;
438	118					487	my($prm,$value);
439	118					586	my($prmlst)={};
440
441	118					1607	while(($prm,$value)=splice(@$inarray,0,2)) {
442	451					2029	$prm=uc($prm);
443	451	50				3012	exists($$checklist{$prm})
444							or croak("Unknow parameter '$prm'");
445	451	50				3362	ref($value) eq $$checklist{$prm}
446							or croak("Invalid value for parameter '$prm'");
447	451					2546	$prm=unpack('@2A*',$prm);
448	451					5319	$$outhash{$prm}=$value;
449							}
450	118					865	for (@$mandatory) {
451	192	50				1678	exists($$outhash{$_})
452							or croak("Missing mandatory parameter '".lc($_)."'");
453							}
454							}
455
456							sub _Error {
457	0			0		0	print "Parse error.\n";
458							}
459
460							sub _DBLoad {
461							{
462	33 33 33 0			33 0		570 139 350 0	no strict 'refs';
463
464	0 0	0				0 0	exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
465							and return;
466							}
467	0					0	my($fname)=__FILE__;
468	0					0	my(@drv);
469	0					0	local $/ = "\n";
470	0	0				0	open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
471	0					0	while(<DRV>) {
472							/^\ssub\s+_Parse\s{\s$/ .. /^\s}\s#\s_Parse\s*$/
473	0	0				0	and do {
474	0					0	s/^#DBG>//;
475	0					0	push(@drv,$_);
476							}
477							}
478	0					0	close(DRV);
479
480	0					0	$drv[0]=~s/_P/_DBP/;
481	0					0	eval join('',@drv);
482							}
483
484							#Note that for loading debugging version of the driver,
485							#this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
486							#So, DO NOT remove comment at end of sub !!!
487							sub _Parse {
488	64			64		378	my($self)=shift;
489
490	64					621	my($rules,$states,$lex,$error)
491							= @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
492	64					820	my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
493							= @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
494
495							#DBG> my($debug)=$$self{DEBUG};
496							#DBG> my($dbgerror)=0;
497
498							#DBG> my($ShowCurToken) = sub {
499							#DBG> my($tok)='>';
500							#DBG> for (split('',$$token)) {
501							#DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
502							#DBG> ? sprintf('<%02X>',ord($_))
503							#DBG> : $_;
504							#DBG> }
505							#DBG> $tok.='<';
506							#DBG> };
507
508	64					373	$$errstatus=0;
509	64					354	$$nberror=0;
510	64					461	($$token,$$value)=(undef,undef);
511	64					647	@$stack=( [ 0, undef ] );
512	64					365	$$check='';
513
514	64					252	while(1) {
515	2070					7507	my($actions,$act,$stateno);
516
517	2070					9329	$stateno=$$stack[-1][0];
518	2070					8129	$actions=$$states[$stateno];
519
520							#DBG> print STDERR ('-' x 40),"\n";
521							#DBG> $debug & 0x2
522							#DBG> and print STDERR "In state $stateno:\n";
523							#DBG> $debug & 0x08
524							#DBG> and print STDERR "Stack:[".
525							#DBG> join(',',map { $$_[0] } @$stack).
526							#DBG> "]\n";
527
528
529	2070	100				11598	if (exists($$actions{ACTIONS})) {
530
531							defined($$token)
532	1250	100				7209	or do {
533	907					5142	($$token,$$value)=&$lex($self);
534							#DBG> $debug & 0x01
535							#DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
536							};
537
538	1250	100 100				19360	$act= exists($$actions{ACTIONS}{$$token})
539							? $$actions{ACTIONS}{$$token}
540							: exists($$actions{DEFAULT})
541							? $$actions{DEFAULT}
542							: undef;
543							}
544							else {
545	820					3739	$act=$$actions{DEFAULT};
546							#DBG> $debug & 0x01
547							#DBG> and print STDERR "Don't need token.\n";
548							}
549
550							defined($act)
551	2070	100				11902	and do {
552
553							$act > 0
554	2058	100				11469	and do { #shift
555
556							#DBG> $debug & 0x04
557							#DBG> and print STDERR "Shift and go to state $act.\n";
558
559							$$errstatus
560	897	100				4761	and do {
561	2					9	--$$errstatus;
562
563							#DBG> $debug & 0x10
564							#DBG> and $dbgerror
565							#DBG> and $$errstatus == 0
566							#DBG> and do {
567							#DBG> print STDERR "**End of Error recovery.\n";
568							#DBG> $dbgerror=0;
569							#DBG> };
570							};
571
572
573	897					5368	push(@$stack,[ $act, $$value ]);
574
575	897	100				6645	$$token ne '' #Don't eat the eof
576							and $$token=$$value=undef;
577	897					3076	next;
578							};
579
580							#reduce
581	1161					4820	my($lhs,$len,$code,@sempar,$semval);
582	1161 1161					3507 8620	($lhs,$len,$code)=@{$$rules[-$act]};
583
584							#DBG> $debug & 0x04
585							#DBG> and $act
586							#DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
587
588	1161	100				7413	$act
589							or $self->YYAccept();
590
591	1161					4016	$$dotpos=$len;
592
593							unpack('A1',$lhs) eq '@' #In line rule
594	1161	100				8719	and do {
595	10	50				117	$lhs =~ /^\@[0-9]+\-([0-9]+)$/
596							or die "In line rule name '$lhs' ill formed: ".
597							"report it as a BUG.\n";
598	10					68	$$dotpos = $1;
599							};
600
601	2005					11181	@sempar = $$dotpos
602	1161	100				10332	? map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
603							: ();
604
605	1161					6066	$self->{CURRENT_LHS} = $lhs;
606	1161					5006	$self->{CURRENT_RULE} = -$act; # count the super-rule?
607	1161	100 100				9235	$semval = $code ? &$code( $self, @sempar )
608							: @sempar ? $sempar[0] : undef;
609
610	1161					7447	splice(@$stack,-$len,$len);
611
612							$$check eq 'ACCEPT'
613	1161	100				7735	and do {
614
615							#DBG> $debug & 0x04
616							#DBG> and print STDERR "Accept.\n";
617
618	64					533	return($semval);
619							};
620
621							$$check eq 'ABORT'
622	1097	50				6188	and do {
623
624							#DBG> $debug & 0x04
625							#DBG> and print STDERR "Abort.\n";
626
627	0					0	return(undef);
628
629							};
630
631							#DBG> $debug & 0x04
632							#DBG> and print STDERR "Back to state $$stack[-1][0], then ";
633
634							$$check eq 'ERROR'
635	1097	50				6571	or do {
636							#DBG> $debug & 0x04
637							#DBG> and print STDERR
638							#DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
639
640							#DBG> $debug & 0x10
641							#DBG> and $dbgerror
642							#DBG> and $$errstatus == 0
643							#DBG> and do {
644							#DBG> print STDERR "**End of Error recovery.\n";
645							#DBG> $dbgerror=0;
646							#DBG> };
647
648	1097					10847	push(@$stack,
649							[ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
650	1097					4034	$$check='';
651	1097					7514	next;
652							};
653
654							#DBG> $debug & 0x04
655							#DBG> and print STDERR "Forced Error recovery.\n";
656
657	0					0	$$check='';
658
659							};
660
661							#Error
662							$$errstatus
663	12	100				70	or do {
664
665	2					7	$$errstatus = 1;
666	2					68	&$error($self);
667	2	50				13	$$errstatus # if 0, then YYErrok has been called
668							or next; # so continue parsing
669
670							#DBG> $debug & 0x10
671							#DBG> and do {
672							#DBG> print STDERR "**Entering Error recovery.\n";
673							#DBG> ++$dbgerror;
674							#DBG> };
675
676	2					10	++$$nberror;
677
678							};
679
680							$$errstatus == 3 #The next token is not valid: discard it
681	12	100				83	and do {
682							$$token eq '' # End of input: no hope
683	10	50				57	and do {
684							#DBG> $debug & 0x10
685							#DBG> and print STDERR "**At eof: aborting.\n";
686	0					0	return(undef);
687							};
688
689							#DBG> $debug & 0x10
690							#DBG> and print STDERR "**Discard invalid token ".&$ShowCurToken.".\n";
691
692	10					43	$$token=$$value=undef;
693							};
694
695	12					43	$$errstatus=3;
696
697	12		40			385	while( @$stack
698							and ( not exists($$states[$$stack[-1][0]]{ACTIONS})
699							or not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
700							or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
701
702							#DBG> $debug & 0x10
703							#DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
704
705	13					486	pop(@$stack);
706							}
707
708							@$stack
709	12	50				69	or do {
710
711							#DBG> $debug & 0x10
712							#DBG> and print STDERR "**No state left on stack: aborting.\n";
713
714	0					0	return(undef);
715							};
716
717							#shift the error token
718
719							#DBG> $debug & 0x10
720							#DBG> and print STDERR "**Shift \$error token and go to state ".
721							#DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
722							#DBG> ".\n";
723
724	12					125	push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
725
726							}
727
728							#never reached
729	0						croak("Error in driver logic. Please, report it as a BUG");
730
731							}#_Parse
732							#DO NOT remove comment
733
734							1;
735