File Coverage

blib/lib/Text/Spintax/grammar.pm
Criterion Covered Total %
statement 95 172 55.2
branch 31 72 43.0
condition 1 12 8.3
subroutine 14 26 53.8
pod n/a
total 141 282 50.0


line stmt bran cond sub pod time code
1             ####################################################################
2             #
3             # This file was generated using Parse::Yapp version 1.05.
4             #
5             # Don't edit this file, use source file instead.
6             #
7             # ANY CHANGE MADE HERE WILL BE LOST !
8             #
9             ####################################################################
10             package Text::Spintax::grammar;
11 2     2   153 use vars qw ( @ISA );
  2         7  
  2         139  
12 2     2   14 use strict;
  2         4  
  2         73  
13 2     2   11 use warnings;
  2         3  
  2         294  
14              
15             @ISA= qw ( Text::Spintax::Parse::Yapp::Driver );
16             #Included Parse/Yapp/Driver.pm file----------------------------------------
17             {
18             #
19             # Module Parse::Yapp::Driver
20             #
21             # This module is part of the Parse::Yapp package available on your
22             # nearest CPAN
23             #
24             # Any use of this module in a standalone parser make the included
25             # text under the same copyright as the Parse::Yapp module itself.
26             #
27             # This notice should remain unchanged.
28             #
29             # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
30             # (see the pod text in Parse::Yapp module for use and distribution rights)
31             #
32              
33             package Text::Spintax::Parse::Yapp::Driver;
34              
35             require 5.004;
36              
37 2     2   14 use strict;
  2         5  
  2         75  
38 2     2   11 use warnings;
  2         3  
  2         92  
39              
40 2     2   13 use vars qw ( $VERSION $COMPATIBLE $FILENAME );
  2         4  
  2         210  
41              
42             $VERSION = '1.05';
43             $COMPATIBLE = '0.07';
44             $FILENAME=__FILE__;
45              
46 2     2   16 use Carp;
  2         3  
  2         3097  
47              
48             #Known parameters, all starting with YY (leading YY will be discarded)
49             my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
50             YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
51             #Mandatory parameters
52             my(@params)=('LEX','RULES','STATES');
53              
54             sub new {
55 1     1   4 my($class)=shift;
56 1         2 my($errst,$nberr,$token,$value,$check,$dotpos);
57 1         16 my($self)={ ERROR => \&_Error,
58             ERRST => \$errst,
59             NBERR => \$nberr,
60             TOKEN => \$token,
61             VALUE => \$value,
62             DOTPOS => \$dotpos,
63             STACK => [],
64             DEBUG => 0,
65             CHECK => \$check };
66              
67 1         7 _CheckParams( [], \%params, \@_, $self );
68              
69 1 50 33     22 exists($$self{VERSION})
70             and $$self{VERSION} < $COMPATIBLE
71             and croak "Yapp driver version $VERSION ".
72             "incompatible with version $$self{VERSION}:\n".
73             "Please recompile parser module.";
74              
75 1 50       3 ref($class)
76             and $class=ref($class);
77              
78 1         8 bless($self,$class);
79             }
80              
81             sub YYParse {
82 1     1   2 my($self)=shift;
83 1         13 my($retval);
84              
85 1         9 _CheckParams( \@params, \%params, \@_, $self );
86              
87 1 50       6 if($$self{DEBUG}) {
88 0         0 _DBLoad();
89 0         0 $retval = eval '$self->_DBParse()';#Do not create stab entry on compile
90 0 0       0 $@ and die $@;
91             }
92             else {
93 1         11 $retval = $self->_Parse();
94             }
95 1         6 $retval
96             }
97              
98             sub YYData {
99 42     42   280 my($self)=shift;
100              
101 42 100       112 exists($$self{USER})
102             or $$self{USER}={};
103              
104 42         255 $$self{USER};
105            
106             }
107              
108             sub YYErrok {
109 0     0   0 my($self)=shift;
110              
111 0         0 ${$$self{ERRST}}=0;
  0         0  
112 0         0 undef;
113             }
114              
115             sub YYNberr {
116 0     0   0 my($self)=shift;
117              
118 0         0 ${$$self{NBERR}};
  0         0  
119             }
120              
121             sub YYRecovering {
122 0     0   0 my($self)=shift;
123              
124 0         0 ${$$self{ERRST}} != 0;
  0         0  
125             }
126              
127             sub YYAbort {
128 0     0   0 my($self)=shift;
129              
130 0         0 ${$$self{CHECK}}='ABORT';
  0         0  
131 0         0 undef;
132             }
133              
134             sub YYAccept {
135 1     1   3 my($self)=shift;
136              
137 1         2 ${$$self{CHECK}}='ACCEPT';
  1         5  
138 1         3 undef;
139             }
140              
141             sub YYError {
142 0     0   0 my($self)=shift;
143              
144 0         0 ${$$self{CHECK}}='ERROR';
  0         0  
145 0         0 undef;
146             }
147              
148             sub YYSemval {
149 0     0   0 my($self)=shift;
150 0         0 my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
  0         0  
151              
152 0         0 $index < 0
153 0 0 0     0 and -$index <= @{$$self{STACK}}
154             and return $$self{STACK}[$index][1];
155              
156 0         0 undef; #Invalid index
157             }
158              
159             sub YYCurtok {
160 0     0   0 my($self)=shift;
161              
162             @_
163 0 0       0 and ${$$self{TOKEN}}=$_[0];
  0         0  
164 0         0 ${$$self{TOKEN}};
  0         0  
165             }
166              
167             sub YYCurval {
168 0     0   0 my($self)=shift;
169              
170             @_
171 0 0       0 and ${$$self{VALUE}}=$_[0];
  0         0  
172 0         0 ${$$self{VALUE}};
  0         0  
173             }
174              
175             sub YYExpect {
176 0     0   0 my($self)=shift;
177              
178 0         0 keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
  0         0  
179             }
180              
181             sub YYLexer {
182 0     0   0 my($self)=shift;
183              
184 0         0 $$self{LEX};
185             }
186              
187              
188             #################
189             # Private stuff #
190             #################
191              
192              
193             sub _CheckParams {
194 2     2   5 my($mandatory,$checklist,$inarray,$outhash)=@_;
195 2         3 my($prm,$value);
196 2         17 my($prmlst)={};
197              
198 2         28 while(($prm,$value)=splice(@$inarray,0,2)) {
199 5         10 $prm=uc($prm);
200 5 50       16 exists($$checklist{$prm})
201             or croak("Unknow parameter '$prm'");
202 5 50       21 ref($value) eq $$checklist{$prm}
203             or croak("Invalid value for parameter '$prm'");
204 5         18 $prm=unpack('@2A*',$prm);
205 5         25 $$outhash{$prm}=$value;
206             }
207 2         8 for (@$mandatory) {
208 3 50       13 exists($$outhash{$_})
209             or croak("Missing mandatory parameter '".lc($_)."'");
210             }
211             }
212              
213             sub _Error {
214 0     0   0 print "Parse error.\n";
215             }
216              
217             sub _DBLoad {
218             {
219 2     2   26 no strict 'refs';
  2     0   3  
  2         4060  
  0         0  
220              
221 0 0       0 exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
  0         0  
222             and return;
223             }
224 0         0 my($fname)=__FILE__;
225 0         0 my(@drv);
226 0 0       0 open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
227 0         0 while() {
228             /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
229 0 0       0 and do {
230 0         0 s/^#DBG>//;
231 0         0 push(@drv,$_);
232             }
233             }
234 0         0 close(DRV);
235              
236 0         0 $drv[0]=~s/_P/_DBP/;
237 0         0 eval join('',@drv);
238             }
239              
240             #Note that for loading debugging version of the driver,
241             #this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
242             #So, DO NOT remove comment at end of sub !!!
243             sub _Parse {
244 1     1   3 my($self)=shift;
245              
246 1         5 my($rules,$states,$lex,$error)
247             = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
248 1         5 my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
249             = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
250              
251             #DBG> my($debug)=$$self{DEBUG};
252             #DBG> my($dbgerror)=0;
253              
254             #DBG> my($ShowCurToken) = sub {
255             #DBG> my($tok)='>';
256             #DBG> for (split('',$$token)) {
257             #DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
258             #DBG> ? sprintf('<%02X>',ord($_))
259             #DBG> : $_;
260             #DBG> }
261             #DBG> $tok.='<';
262             #DBG> };
263              
264 1         3 $$errstatus=0;
265 1         2 $$nberror=0;
266 1         3 ($$token,$$value)=(undef,undef);
267 1         5 @$stack=( [ 0, undef ] );
268 1         3 $$check='';
269              
270 1         2 while(1) {
271 33         40 my($actions,$act,$stateno);
272              
273 33         44 $stateno=$$stack[-1][0];
274 33         41 $actions=$$states[$stateno];
275              
276             #DBG> print STDERR ('-' x 40),"\n";
277             #DBG> $debug & 0x2
278             #DBG> and print STDERR "In state $stateno:\n";
279             #DBG> $debug & 0x08
280             #DBG> and print STDERR "Stack:[".
281             #DBG> join(',',map { $$_[0] } @$stack).
282             #DBG> "]\n";
283              
284              
285 33 100       82 if (exists($$actions{ACTIONS})) {
286              
287             defined($$token)
288 8 50       23 or do {
289 8         31 ($$token,$$value)=&$lex($self);
290             #DBG> $debug & 0x01
291             #DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
292             };
293              
294 8 0       184 $act= exists($$actions{ACTIONS}{$$token})
    50          
295             ? $$actions{ACTIONS}{$$token}
296             : exists($$actions{DEFAULT})
297             ? $$actions{DEFAULT}
298             : undef;
299             }
300             else {
301 25         39 $act=$$actions{DEFAULT};
302             #DBG> $debug & 0x01
303             #DBG> and print STDERR "Don't need token.\n";
304             }
305              
306             defined($act)
307 33 50       71 and do {
308              
309             $act > 0
310 33 100       67 and do { #shift
311              
312             #DBG> $debug & 0x04
313             #DBG> and print STDERR "Shift and go to state $act.\n";
314              
315             $$errstatus
316 8 50       20 and do {
317 0         0 --$$errstatus;
318              
319             #DBG> $debug & 0x10
320             #DBG> and $dbgerror
321             #DBG> and $$errstatus == 0
322             #DBG> and do {
323             #DBG> print STDERR "**End of Error recovery.\n";
324             #DBG> $dbgerror=0;
325             #DBG> };
326             };
327              
328              
329 8         26 push(@$stack,[ $act, $$value ]);
330              
331 8 100       28 $$token ne '' #Don't eat the eof
332             and $$token=$$value=undef;
333 8         19 next;
334             };
335              
336             #reduce
337 25         83 my($lhs,$len,$code,@sempar,$semval);
338 25         26 ($lhs,$len,$code)=@{$$rules[-$act]};
  25         72  
339              
340             #DBG> $debug & 0x04
341             #DBG> and $act
342             #DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
343              
344 25 100       74 $act
345             or $self->YYAccept();
346              
347 25         31 $$dotpos=$len;
348              
349             unpack('A1',$lhs) eq '@' #In line rule
350 25 50       104 and do {
351 0 0       0 $lhs =~ /^\@[0-9]+\-([0-9]+)$/
352             or die "In line rule name '$lhs' ill formed: ".
353             "report it as a BUG.\n";
354 0         0 $$dotpos = $1;
355             };
356              
357 32         92 @sempar = $$dotpos
358 25 100       109 ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
359             : ();
360              
361 25 100       99 $semval = $code ? &$code( $self, @sempar )
    100          
362             : @sempar ? $sempar[0] : undef;
363              
364 25         50 splice(@$stack,-$len,$len);
365              
366             $$check eq 'ACCEPT'
367 25 100       68 and do {
368              
369             #DBG> $debug & 0x04
370             #DBG> and print STDERR "Accept.\n";
371              
372 1         7 return($semval);
373             };
374              
375             $$check eq 'ABORT'
376 24 50       47 and do {
377              
378             #DBG> $debug & 0x04
379             #DBG> and print STDERR "Abort.\n";
380              
381 0         0 return(undef);
382              
383             };
384              
385             #DBG> $debug & 0x04
386             #DBG> and print STDERR "Back to state $$stack[-1][0], then ";
387              
388             $$check eq 'ERROR'
389 24 50       53 or do {
390             #DBG> $debug & 0x04
391             #DBG> and print STDERR
392             #DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
393              
394             #DBG> $debug & 0x10
395             #DBG> and $dbgerror
396             #DBG> and $$errstatus == 0
397             #DBG> and do {
398             #DBG> print STDERR "**End of Error recovery.\n";
399             #DBG> $dbgerror=0;
400             #DBG> };
401              
402 24         91 push(@$stack,
403             [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
404 24         42 $$check='';
405 24         176 next;
406             };
407              
408             #DBG> $debug & 0x04
409             #DBG> and print STDERR "Forced Error recovery.\n";
410              
411 0           $$check='';
412              
413             };
414              
415             #Error
416             $$errstatus
417 0 0         or do {
418              
419 0           $$errstatus = 1;
420 0           &$error($self);
421 0 0         $$errstatus # if 0, then YYErrok has been called
422             or next; # so continue parsing
423              
424             #DBG> $debug & 0x10
425             #DBG> and do {
426             #DBG> print STDERR "**Entering Error recovery.\n";
427             #DBG> ++$dbgerror;
428             #DBG> };
429              
430 0           ++$$nberror;
431              
432             };
433              
434             $$errstatus == 3 #The next token is not valid: discard it
435 0 0         and do {
436             $$token eq '' # End of input: no hope
437 0 0         and do {
438             #DBG> $debug & 0x10
439             #DBG> and print STDERR "**At eof: aborting.\n";
440 0           return(undef);
441             };
442              
443             #DBG> $debug & 0x10
444             #DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
445              
446 0           $$token=$$value=undef;
447             };
448              
449 0           $$errstatus=3;
450              
451 0   0       while( @$stack
      0        
452             and ( not exists($$states[$$stack[-1][0]]{ACTIONS})
453             or not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
454             or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
455              
456             #DBG> $debug & 0x10
457             #DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
458              
459 0           pop(@$stack);
460             }
461              
462             @$stack
463 0 0         or do {
464              
465             #DBG> $debug & 0x10
466             #DBG> and print STDERR "**No state left on stack: aborting.\n";
467              
468 0           return(undef);
469             };
470              
471             #shift the error token
472              
473             #DBG> $debug & 0x10
474             #DBG> and print STDERR "**Shift \$error token and go to state ".
475             #DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
476             #DBG> ".\n";
477              
478 0           push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
479              
480             }
481              
482             #never reached
483 0           croak("Error in driver logic. Please, report it as a BUG");
484              
485             }#_Parse
486             #DO NOT remove comment
487              
488             1;
489              
490             }
491             #End of include--------------------------------------------------
492              
493              
494             #line 1 "lib/Text/Spintax/grammar.yp"
495              
496             # header code goes here
497              
498              
499             sub new {
500             my($class)=shift;
501             ref($class)
502             and $class=ref($class);
503              
504             my($self)=$class->SUPER::new( yyversion => '1.05',
505             yystates =>
506             [
507             {#State 0
508             DEFAULT => -11,
509             GOTOS => {
510             'elements' => 1
511             }
512             },
513             {#State 1
514             ACTIONS => {
515             '' => 3,
516             'TEXT' => 2,
517             'OBRACE' => 4
518             },
519             GOTOS => {
520             'text' => 5,
521             'parser_spin' => 6,
522             'element' => 8,
523             'obrace' => 7
524             }
525             },
526             {#State 2
527             DEFAULT => -1
528             },
529             {#State 3
530             DEFAULT => 0
531             },
532             {#State 4
533             DEFAULT => -6
534             },
535             {#State 5
536             DEFAULT => -2
537             },
538             {#State 6
539             DEFAULT => -3
540             },
541             {#State 7
542             DEFAULT => -8,
543             GOTOS => {
544             'elementpipes' => 9
545             }
546             },
547             {#State 8
548             DEFAULT => -12
549             },
550             {#State 9
551             DEFAULT => -11,
552             GOTOS => {
553             'elements' => 10,
554             'elementpipe' => 11
555             }
556             },
557             {#State 10
558             ACTIONS => {
559             'TEXT' => 2,
560             'OBRACE' => 4,
561             'EBRACE' => 13,
562             'PIPE' => 15
563             },
564             GOTOS => {
565             'ebrace' => 12,
566             'text' => 5,
567             'pipe' => 14,
568             'parser_spin' => 6,
569             'element' => 8,
570             'obrace' => 7
571             }
572             },
573             {#State 11
574             DEFAULT => -9
575             },
576             {#State 12
577             DEFAULT => -10
578             },
579             {#State 13
580             DEFAULT => -5
581             },
582             {#State 14
583             DEFAULT => -4
584             },
585             {#State 15
586             DEFAULT => -7
587             }
588             ],
589             yyrules =>
590             [
591             [#Rule 0
592             '$start', 2, undef
593             ],
594             [#Rule 1
595             'text', 1,
596             sub
597             #line 12 "lib/Text/Spintax/grammar.yp"
598             { $_[0]->YYData->{tree}->add_child("text",$_[0]->YYData->{DATA}[1],$_[0]->YYData->{DATA}[2]); }
599             ],
600             [#Rule 2
601             'element', 1, undef
602             ],
603             [#Rule 3
604             'element', 1,
605             sub
606             #line 14 "lib/Text/Spintax/grammar.yp"
607             { }
608             ],
609             [#Rule 4
610             'elementpipe', 2,
611             sub
612             #line 16 "lib/Text/Spintax/grammar.yp"
613             { }
614             ],
615             [#Rule 5
616             'ebrace', 1,
617             sub
618             #line 18 "lib/Text/Spintax/grammar.yp"
619             { $_[0]->YYData->{tree}->ebrace; }
620             ],
621             [#Rule 6
622             'obrace', 1,
623             sub
624             #line 20 "lib/Text/Spintax/grammar.yp"
625             { $_[0]->YYData->{tree}->obrace; }
626             ],
627             [#Rule 7
628             'pipe', 1,
629             sub
630             #line 22 "lib/Text/Spintax/grammar.yp"
631             { $_[0]->YYData->{tree}->add_child("pipe") }
632             ],
633             [#Rule 8
634             'elementpipes', 0, undef
635             ],
636             [#Rule 9
637             'elementpipes', 2,
638             sub
639             #line 26 "lib/Text/Spintax/grammar.yp"
640             { }
641             ],
642             [#Rule 10
643             'parser_spin', 4,
644             sub
645             #line 29 "lib/Text/Spintax/grammar.yp"
646             { $_[0]->YYData->{tree}->last_child->{type} = "spin"; }
647             ],
648             [#Rule 11
649             'elements', 0, undef
650             ],
651             [#Rule 12
652             'elements', 2, undef
653             ]
654             ],
655             @_);
656             bless($self,$class);
657             }
658              
659             #line 36 "lib/Text/Spintax/grammar.yp"
660              
661              
662              
663              
664             1;