The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# A set of rules for parsing Signatures in perl6

# XXX no support for isLValue, isWritable, or isLazy (don't understand isLazy)
#       described in InternalNames.hs line 798

# ??? does (terminates => *) work with any named rule?  
#       Can I do <param(terminates => ',')>?
#       What about [ <foo> <bar> ](terminates => *)

grammar Signature {

    # XXX add unicode alternatives
    token open_q      { <[<]> } 
    token close_q     { <[>]> }
    token open_qq     { <[<]**{2}> } # ??? is this syntax right?
    token close_qq    { <[>]**{2}> }
    token open_paren  { <[(]> }
    token close_paren { <[)]> }
    token open_curly  { <[{]> }
    token close_curly { <[}]> }
    token open_array  { <[[]> }
    token close_array { <[\]]> }
    
    # stand-in for bracketing constructs
    # XXX add more or get unicode character classes working
    # XXX after matching an open_group symbol, only count the
    #       appropriate close_group as a match
    token open_group  {
        [
        | <open_q>
        | <open_qq>
        | <open_paren>
        | <open_curly>
        | <open_array>
        ]
    }
    token close_group  {
        [
        | <close_q>
        | <close_qq>
        | <close_paren>
        | <close_curly>
        | <close_array>
        ]
    }
    token close_param { <[,)]> }

    # separator used in multi sigs to separate multiple levels of invocants
    token tie_break { <[:]> }
    
    # perl6 sigils in signatures
    token is_array  { $<context> := <[@]> }
    token is_scalar { $<context> := <[$]> }
    token is_code   { $<context> := <[&]> }
    token is_hash   { $<context> := <[%]> }
    token sigil     { <is_scalar> | <is_array> | <is_hash> | <is_code> }

    # names don't have \d as the first character and have
    # at least one non-_ character
    token param_name   { [ <alpha> | _ ]+ [ <alpha> | \d | _ ]+  }
    token internal     { <param_name> }
    token external     { <param_name> }

    # defaults for arguments can be assigned in the sig
    token default { = <?ws>? $<default> := <expression( terminates => ',' )> }
    
    # types start with an uppercase letter
    token type_name { <upper>+ [ <alpha> | _ | \d ]* }
    token type      { <type_name> }
    token ret_type  { <type_name> }
    token type_var  { <type_name> }
    token ret_arrow { \-\-\> }
    token returns   { <ret_arrow> <?ws>* <ret_type> }
    
    # parse *@x and :$x and mark for slurpy/named
    token is_named    { <[:]> }
    token is_slurpy   { <[*]> }
    token prefix_mod  { [ <is_named> | <is_slurpy> ] }

    # parse $x! and $x? and mark for required/optional
    token is_optional  { <[?]> }
    token is_required  { <[!]> }
    token postfix_mod  { [ <is_optional> | <is_required> ] }

    # parse $^x and mark it as an implicit.  leave room for other twigils
    token is_implicit { <[^]> }
    token twigil      { <is_implicit> }

    # traits have the same rules for names as params
    token trait_name := param_name;
    token trait { is <?ws>+ <trait_name> }
    
    # this allows specifying a type on a parameter, as well parameterizing that type.
    token dwigil    { [:]**{2} }
    token declarator { my | our | has | env | state | constant }
    token type_param { <type> <?ws>+ [ <dwigil> <?ws>* <type_var> ]? }

    # $x, $^x, $
    token positional {
        [ <sigil> <twigil>? $<internal> := <external>? ]
    }

    # :$x, :x($y), :$, :$(x)
    token named {
        <is_named>
        [
        | <sigil> $<internal> := <external>?
        | <open_group> <external>? <sigil> <internal> <close_group>
        ]
    }

    # *@x
    token slurpy {
        <declarator>? <type_param>? <is_slurpy> <positional>? <trait>* <default>?
    }

    # [ $x, *@y ]
    # ??? how should unpacked params be accessed?  in $<unpacked>?
    #   in some cases they'll be aliased to something in $<positional|named>
    #   in other cases, they'll act as anonymous $<positional>
    token unpacked {
        <open_group> <?ws>* <declarator>? <type_param>? <positional>+ <trait>* <slurpy>* <?ws>* <close_group>
    }
        
    rule param {
        <declarator>? <type_param>?
        [
        | <positional>
        | <named>
        | <unpacked>
        ]
        <postfix_mod>? <trait>* <default>?
    }
        
    # signature for a single dispatch routine
    # ??? does this definition backtrack
    rule single_sig {
        [ <param> <unpacked>? <close_param> ]* <slurpy>* <returns>?
    }

    # sig for multi dispatch routine
    rule multi_sig {
        <single_sig> [ <tie_break> <single_sig> ]* <tieBreak>?
        : { @single_sig[ *..( +$<tiebreak> - 1 ) ]<is_invocant> >>++ } # thanks audreyt++
    }
}