/usr/local/CPAN/Perl6-Pugs/P6P6Rule.pm

# Perl6 implementation of the 'Rule' syntax 
# author: Flavio S. Glock - fglock@gmail.com

use v6-alpha;

grammar Pugs::Grammar::P6Rule
    does Pugs::Grammar::BaseCategory;
# this file was extracted from the P6 version in Pugs-Compiler-Rule

use Pugs::Compiler::Rule;
use Pugs::Compiler::Token;
use Pugs::Compiler::Regex;
use Pugs::Grammar::Perl6;
use Pugs::Runtime::Match;

our @rule_terms;

# TODO - reuse 'ident' from other modules
regex ident {
    [ <alnum> | _ | <'::'> ]+
}

token capturing_group {
    \( <rule> \)
    { return { capturing_group => $/{rule}() ,} }
}

token non_capturing_group {
    \[ <rule> \] 
    { return $/{rule}() }
}

regex metasyntax {
    \< ([ <metasyntax> | . ]+?) \>
        { return { metasyntax => $/[0]() ,} }
}

token named_capture_body {
        | <capturing_group>     { return { rule => $/{capturing_group}(), } } 
        | <non_capturing_group> { return { rule => $/{non_capturing_group}(),} } 
        | <metasyntax>          { return { rule => $/{metasyntax}(), } } 
        | { die "invalid alias syntax" }
}

@Pugs::Grammar::P6Rule::rule_terms = (

    #*capturing_group = 
    token {
                \( <rule> \)
                { return { capturing_group => $/{rule}() ,} }
        },
    #*after = 
    token {
                \< after <?ws> <rule> \> 
        { return { after => {
                rule  => $/{rule}(),
            }, } 
        }
    },
  #*before = 
  token {
        \< before <?ws> <rule> \> 
        { return { before => {
                rule  => $/{rule}(),
            }, } 
        }
    },
  #*negate = 
  token {
        \< \! <rule> \> 
        { return { negate => {
                rule  => $/{rule}(),
            }, } 
        }
    },
  regex { 
    #metasyntax => 
        \< ([ <metasyntax> | \\ . | . ]+?) \>
                { return { metasyntax => $/[0]() ,} }
        },
    #*named_capture = 
    token {
                \$ \< <ident> \> <?ws>? \:\= <?ws>? <named_capture_body>
                { my $body = $/{named_capture_body}();
                    $body->{ident} = $/{ident}();
                    return { named_capture => $body, } 
                }
        },
    regex { 
        #match_variable 
                [ \$ | \@ | \% ] <digit>+
                { return { match_variable => $/() ,} }
        },
    regex { 
        #variable_rule => 
                [ \$ | \@ | \% ]
                \^?
        [ <alnum> | _ | \: \: ]+
        { return { variable => $() ,} }
    },
  regex { 
    # closure_rule => 
        # callback perl6 compiler
        \{ <Pugs::Grammar::Perl6.parse> \}
        { return { closure => $/{'Pugs::Grammar::Perl6.parse'}() ,} }
    },
  regex {  
    #special_char => 
        \\ .
        { return { special_char => $(), } } 
    },
  Pugs::Compiler::Token->compile( 
    #dot => 
        \.    
        { return { 'dot' => 1 ,} }
    },
  Pugs::Compiler::Token->compile( 
    #non_capturing_group => 
        \[ <rule> \] 
        { return $/{rule}() }
    },
  #*colon = 
  token {
        (  <':::'>  
        |  \:\?     
                |  \:\+     
                |  \:\:  |  \: 
                |  \$\$  |  \$ 
                |  \^\^  |  \^
                )  
                { return { colon => $/() ,} }
        },
); # /@rule_terms
        
token term {
        |  <before \} > { fail } 
        |  <before \] > { fail } 
        |  <before \) > { fail } 
        |  <before \> > { fail } 
        |  <@Pugs::Grammar::P6Rule::rule_terms>
                { 
                        #print "term: ", Dumper( $_[0]->data );
                        return $/{'Pugs::Grammar::P6Rule::rule_terms'}() 
                }
        |  ( <-[ \] \} \) \> \: \? \+ \* \| \& ]> )
                { 
                        #print "constant: ", Dumper( $_[0]->data );
                        return { 'constant' => $/[0]->() ,} 
                }
}

token quantifier {
        $<ws1>   := (<?ws>?)
        <term> 
        $<ws2>   := (<?ws>?)
        $<quant> := (
                |  <'??'>  
                |  <'*?'>  
                |  <'+?'> 
                |  <'?'>  
                |  <'*'>  
                |  <'+'> 
                |  <null>   )
        $<ws3>   := (<?ws>?)
        { return {  
                        term  => $/{term}(),
                        quant => $/{quant}(),
                        ws1   => $/{ws1}(),
                        ws2   => $/{ws2}(),
                        ws3   => $/{ws3}(),
                } 
        }
}

token concat {
        $<q1> := <quantifier> 
        [   $<q2> := <concat> 
                { return { concat => [ 
                                { quant => $/{q1}() ,}, 
                                $/{q2}(),
                        ] ,} 
                } 
        |   { return { quant => $/{q1}() ,} } 
        ]
}

token rule {
        [ <?ws>? \| ]?
        $<q1> := <concat> 
        [   \| $<q2> := <rule> 
                { return { alt => [ 
                                $/{q1}(), 
                                $/{q2}(),
                        ] ,} 
                }
        |   { return $/{q1}() } 
        ]
}