view release on metacpan or  search on metacpan

lib/Data/SExpression/Parser.pm  view on Meta::CPAN

			and	do {
#DBG>				$debug & 0x10
#DBG>			and	print STDERR "**At eof: aborting.\n";
				return(undef);
			};

#DBG>			$debug & 0x10
#DBG>		and	print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";

			$$token=$$value=undef;
		};

        $$errstatus=3;

		while(	  @$stack
			  and (		not exists($$states[$$stack[-1][0]]{ACTIONS})
			        or  not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
					or	$$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {

#DBG>			$debug & 0x10
#DBG>		and	print STDERR "**Pop state $$stack[-1][0].\n";

			pop(@$stack);
		}

			@$stack
		or	do {

#DBG>			$debug & 0x10
#DBG>		and	print STDERR "**No state left on stack: aborting.\n";

			return(undef);
		};

		#shift the error token

#DBG>			$debug & 0x10
#DBG>		and	print STDERR "**Shift \$error token and go to state ".
#DBG>						 $$states[$$stack[-1][0]]{ACTIONS}{error}.
#DBG>						 ".\n";

		push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);

    }

    #never reached
	croak("Error in driver logic. Please, report it as a BUG");

}#_Parse
#DO NOT remove comment

1;

}
#End of include--------------------------------------------------


#line 9 "lib/Data/SExpression/Parser.yp"

use Data::SExpression::Cons;
use Scalar::Util qw(weaken);


sub new {
        my($class)=shift;
        ref($class)
    and $class=ref($class);

    my($self)=$class->SUPER::new( yyversion => '1.05',
                                  yystates =>
[
	{#State 0
		ACTIONS => {
			"(" => 5,
			'SYMBOL' => 1,
			'NUMBER' => 8,
			'STRING' => 4,
			'QUOTE' => 3
		},
		GOTOS => {
			'expression' => 7,
			'sexpression' => 6,
			'quoted' => 2,
			'list' => 9
		}
	},
	{#State 1
		DEFAULT => -3
	},
	{#State 2
		DEFAULT => -6
	},
	{#State 3
		ACTIONS => {
			"(" => 5,
			'SYMBOL' => 1,
			'NUMBER' => 8,
			'STRING' => 4,
			'QUOTE' => 3
		},
		GOTOS => {
			'expression' => 10,
			'quoted' => 2,
			'list' => 9
		}
	},
	{#State 4
		DEFAULT => -4
	},
	{#State 5
		ACTIONS => {
			"(" => 5,
			'SYMBOL' => 1,
			'NUMBER' => 8,
			'STRING' => 4,
			'QUOTE' => 3
		},
		DEFAULT => -11,
		GOTOS => {
			'expression' => 11,
			'quoted' => 2,

lib/Data/SExpression/Parser.pm  view on Meta::CPAN

	],
	[#Rule 6
		 'expression', 1, undef
	],
	[#Rule 7
		 'list', 3,
sub
#line 27 "lib/Data/SExpression/Parser.yp"
{ $_[2] }
	],
	[#Rule 8
		 'list_interior', 3,
sub
#line 32 "lib/Data/SExpression/Parser.yp"
{ $_[0]->handler->new_cons($_[1], $_[3]) }
	],
	[#Rule 9
		 'list_interior', 2,
sub
#line 33 "lib/Data/SExpression/Parser.yp"
{ $_[0]->handler->new_cons($_[1], $_[2]) }
	],
	[#Rule 10
		 'list_interior', 1,
sub
#line 34 "lib/Data/SExpression/Parser.yp"
{ $_[0]->handler->new_cons($_[1], undef) }
	],
	[#Rule 11
		 'list_interior', 0,
sub
#line 35 "lib/Data/SExpression/Parser.yp"
{ undef }
	],
	[#Rule 12
		 'quoted', 2,
sub
#line 40 "lib/Data/SExpression/Parser.yp"
{ $_[0]->handler->new_cons($_[0]->handler->new_symbol($_[1]),
                                                                    $_[0]->handler->new_cons($_[2], undef))}
	]
],
                                  @_);
    bless($self,$class);
}

#line 44 "lib/Data/SExpression/Parser.yp"


sub set_input {
    my $self = shift;
    my $input = shift;
    die(__PACKAGE__ . "::set_input called with 0 arguments") unless defined($input);
    $self->YYData->{INPUT} = $input;
}

sub set_handler {
    my $self = shift;
    my $handler = shift or die(__PACKAGE__ . "::set_handler called with 0 arguments");
    $self->YYData->{HANDLER} = $handler;
    weaken $self->YYData->{HANDLER};
}

sub handler {
    my $self = shift;
    return $self->YYData->{HANDLER};
}

sub unparsed_input {
    my $self = shift;
    return substr($self->YYData->{INPUT}, pos($self->YYData->{INPUT}));
}


my %quotes = (q{'} => 'quote',
              q{`} => 'quasiquote',
              q{,} => 'unquote');


sub lexer {
    my $self = shift;

    defined($self->YYData->{INPUT}) or return ('', undef);

    my $symbol_char = qr{[*!\$[:alpha:]\?<>=/+:_{}-]};

    for($self->YYData->{INPUT}) {
        $_ =~ /\G \s* (?: ; .* \s* )* /gcx;

        /\G ([+-]? \d+ (?:[.]\d*)?) /gcx
        || /\G ([+-]? [.] \d+) /gcx
          and return ('NUMBER', $1);

        /\G ($symbol_char ($symbol_char | \d | [.] )*)/gcx
          and return ('SYMBOL', $1);

        /\G (\| [^|]* \|) /gcx
          and return ('SYMBOL', $1);

        /\G " ([^"\\]* (?: \\. [^"\\]*)*) "/gcx
          and return ('STRING', defined($1) ? $1 : "");

        /\G ([().])/gcx
          and return ($1, $1);

        /\G ([`',]) /gcx
          and return ('QUOTE', $quotes{$1});

        return ('', undef);
    }
}

sub error {
    my $self = shift;
    my ($tok, $val) = $self->YYLexer->($self);
    die("Parse error near: '" . $self->unparsed_input . "'");
    return undef;
}

sub parse {
    my $self = shift;