File Coverage

blib/lib/Sub/Multi/Tiny/SigParse.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

####################################################################
#
#    This file was generated using Parse::Yapp version 1.21.
#
#        Don't edit this file, use source file instead.
#
#             ANY CHANGE MADE HERE WILL BE LOST !
#
####################################################################
package Sub::Multi::Tiny::SigParse;
use vars qw ( @ISA );
use strict;

@ISA= qw ( Parse::Yapp::Driver );
use Parse::Yapp::Driver;

#line 6 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"


# Imports {{{1

use 5.006;
use strict;
use warnings;

use Text::Balanced qw(extract_codeblock);

# Types of constraints we've seen - bit offsets
use enum
    # Flags set by the parser
    'SEEN_WHERE',       # `where` clause
    'SEEN_TYPE',        # Type constraint
    'SEEN_POS',         # Positional argument
    'SEEN_NAMED',       # Named argument
    # future: SEEN_LITERAL for signatures holding literal values
    # instead of name matches.

    # Flags set by later processing
    'HAS_MULTIPLE_ARITIES',     # Set if there are at least two
                                # different positional arities in a
                                # set of impls
;

# Set bits in YYData->{SEEN}
sub _seen {
    vec($_[0]->YYData->{SEEN}, $_[$_], 1) = 1 foreach 1..$#_;
}

# }}}1
# Documentation {{{1

=head1 NAME

Sub::Multi::Tiny::SigParse - Parse::Yapp input to parse signatures in Sub::Multi::Tiny

=head1 SYNOPSIS

Generate the .pm file:

    yapp -m Sub::Multi::Tiny::SigParse -o lib/Sub/Multi/Tiny/SigParse.pm support/SigParse.yp

And then:

    use Sub::Multi::Tiny::SigParse;
    my $ast = Sub::Multi::Tiny::SigParse::Parse($signature);

=head1 FUNCTIONS

=cut

# }}}1



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

    my($self)=$class->SUPER::new( yyversion => '1.21',
                                  yystates =>
[
	{#State 0
		ACTIONS => {
			'PARAM' => 3,
			'TYPE' => 4
		},
		DEFAULT => -1,
		GOTOS => {
			'parameter' => 1,
			'signature' => 2
		}
	},
	{#State 1
		ACTIONS => {
			'SEPAR' => 5
		},
		DEFAULT => -2
	},
	{#State 2
		ACTIONS => {
			'' => 6
		}
	},
	{#State 3
		ACTIONS => {
			'WHERE' => 7
		},
		DEFAULT => -5
	},
	{#State 4
		ACTIONS => {
			'PARAM' => 8
		}
	},
	{#State 5
		ACTIONS => {
			'TYPE' => 4,
			'PARAM' => 3
		},
		DEFAULT => -1,
		GOTOS => {
			'signature' => 9,
			'parameter' => 1
		}
	},
	{#State 6
		DEFAULT => 0
	},
	{#State 7
		DEFAULT => -6
	},
	{#State 8
		ACTIONS => {
			'WHERE' => 10
		},
		DEFAULT => -7
	},
	{#State 9
		ACTIONS => {
			'SEPAR' => 11
		},
		DEFAULT => -3
	},
	{#State 10
		DEFAULT => -8
	},
	{#State 11
		DEFAULT => -4
	}
],
                                  yyrules  =>
[
	[#Rule 0
		 '$start', 2, undef
	],
	[#Rule 1
		 'signature', 0,
sub
#line 86 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{ [] }
	],
	[#Rule 2
		 'signature', 1,
sub
#line 87 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{ [ $_[1] ] }
	],
	[#Rule 3
		 'signature', 3,
sub
#line 88 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{ [ $_[1], @{$_[3]} ] }
	],
	[#Rule 4
		 'signature', 4,
sub
#line 90 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{ [ $_[1], @{$_[3]} ] }
	],
	[#Rule 5
		 'parameter', 1,
sub
#line 95 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{
            _seen $_[0], $_[1]->{named} ? SEEN_NAMED : SEEN_POS;
            return $_[1];
        }
	],
	[#Rule 6
		 'parameter', 2,
sub
#line 101 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{
            _seen $_[0], $_[1]->{named} ? SEEN_NAMED : SEEN_POS;
            _seen $_[0], SEEN_WHERE;
            return +{%{$_[1]}, where=>$_[2]};
        }
	],
	[#Rule 7
		 'parameter', 2,
sub
#line 108 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{
            _seen $_[0], $_[2]->{named} ? SEEN_NAMED : SEEN_POS;
            _seen $_[0], SEEN_TYPE;
            return +{%{$_[2]}, type => $_[1]};
        }
	],
	[#Rule 8
		 'parameter', 3,
sub
#line 115 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"
{
            _seen $_[0], $_[2]->{named} ? SEEN_NAMED : SEEN_POS;
            _seen $_[0], SEEN_TYPE, SEEN_WHERE;
            return +{%{$_[2]}, where=>$_[3], type => $_[1]}
        }
	]
],
                                  @_);
    bless($self,$class);
}

#line 122 "/root/.cpan/build/Sub-Multi-Tiny-0.000012-0/support/SigParse.yp"


#############################################################################
# Footer

# Tokenizer and error-reporting routine for Parse::Yapp {{{1

# The lexer
sub _next_token {
    my $parser = shift;
    my $text = $parser->YYData->{TEXT};

    $$text =~ m/\G\s+/gc;    # Skip H and V whitespace
    $parser->YYData->{CURR_TOK_POS} = pos($$text);

    return ('', undef) unless (pos($$text)||0) < length($$text);    # EOF

    $$text =~ m/\G,/gc and return (SEPAR => 0); # 0 is a dummy value

    if($$text =~ m/\G([:]?)([\$\@\%\&\*]\w+)\b([?!]?)/gc) {
        my $retval = {};
        $retval->{name} = $2;
        $retval->{named} = !!$1;
        $retval->{reqd} = (
            ($retval->{named} && $3 eq '!') ||  # Named: optional unless !
            (!$retval->{named} && $3 ne '?')    # Positional: reqd unless ?
        );
        return (PARAM => $retval);
    }

    if($$text =~ m/\Gwhere\s*\{/gci) {
        pos($$text) -= 1;    # Get the lbrace back
        my ($block) = extract_codeblock($$text);     # Updates pos()
        return (WHERE => $block) if defined $block;
        die "Saw a 'where' without a valid block after it";
    }

    # Permit braced expressions for complex type checks
    if($$text =~ m/\G\{/gc) {
        pos($$text) -= 1;    # Get the lbrace back
        my ($block) = extract_codeblock($$text);     # Updates pos()
        return (TYPE => $block) if defined $block;
        die "Saw an opening brace without a valid block after it";
    }

    # If the next thing is a backslash, die --- prohibit backslash to start
    # a typecheck as a guard against '' vs "" confusion.  If you want a
    # backslash, use the {} form.
    if($$text =~ m{\G\\}gc) {
        die "Saw a backslash where I don't know what to do with it!  ('' vs \"\" confusion?)";
    }

    # Otherwise, assume a single word is a typecheck
    $$text =~ m/\G(\S+)/gc and return (TYPE => $1);

    die "This should never happen!  Unlexable text was: " .
        substr($$text, pos($$text));
} #_next_token()

# Report an error
sub _report_error {
    my $parser = shift;
    my $startpos = $parser->YYData->{CURR_TOK_POS};
    my $endpos = pos(${ $parser->YYData->{TEXT} });
    my $got = $parser->YYCurtok || '<end of input>';
    my $val='';
    $val = ' (' . $parser->YYCurval . ')' if $parser->YYCurval;

    my $errmsg  = 'Syntax error: could not understand ' . $got . $val .
                    " at positions $startpos..$endpos";
    if(ref($parser->YYExpect) eq 'ARRAY') {
        $errmsg .= ".\nExpected one of: " . join(',', @{$parser->YYExpect});
    } else {
        $errmsg .= ':'
    }

    # Print the text and flag the error
    my $copy = ${ $parser->YYData->{TEXT} };
    $copy =~ s/\s/ /g;  # Normalize spaces so pos values line up
    $errmsg .= "\n$copy";
    $errmsg .= "\n" . (' ' x $startpos) . ('^' x ($endpos-$startpos));

    $errmsg .= "\n";    # No stack trace
    die $errmsg;
} #_report_error()

# }}}1
# Top-level parse function {{{1

=head2 Parse

Parse arguments.  Usage:

    my $ast = Sub::Multi::Tiny::SigParse::Parse($signature);

=cut

sub Parse {
    my $text = shift;
    unless(defined $text) {
        require Carp;
        Carp::croak 'Parse: Need a signature to parse';
    }

    my $parser = __PACKAGE__->new;
    my $hrData = $parser->YYData;

    # Data we use while parsing.

    # TEXT: The input text.  Store it as a reference so pos() will
    # be preserved across calls to _next_token.
    $hrData->{TEXT} = \"$text";

    # CURR_TOK_POS: the pos() value where the current token started.
    # Used in reporting errors.
    $hrData->{CURR_TOK_POS} = -1;

    # SEEN: bit flags for which types of things we've seen
    $hrData->{SEEN} = '';

    my $lrParms = $parser->YYParse(yylex => \&_next_token,
        yyerror => \&_report_error,
        (@_ ? (yydebug => $_[0]) : ()),
    );
    my %retval = (seen => $hrData->{SEEN}, parms => $lrParms);

    return \%retval;
} #Parse()

# }}}1
# Rest of the docs {{{1

=head1 AUTHOR

Chris White E<lt>[e-mail]<gt>

=head1 LICENSE

Copyright (C) 2019 Chris White E<lt>[e-mail]<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

# }}}1

# vi: set fdm=marker: #

1;