# this file was extracted from the P6 version in Pugs-Compiler-Rule

package  Pugs::Grammar::P6Rule;
use strict;
use warnings;

use Pugs::Compiler::Rule;
use Pugs::Compiler::Token;
use Pugs::Compiler::Regex;
use base 'Pugs::Grammar::Base';
use Pugs::Runtime::Match::Ratchet; # overload doesn't work without this ???

our @rule_terms;

# reuse some subs
  use Pugs::Grammar::Rule; 
  # XXX - this doesn't work:
  #       "Can't call method "no_match" on an undefined value"
  #*code       = &Pugs::Grammar::Rule::code;
  #*literal    = &Pugs::Grammar::Rule::literal;
  #*metasyntax = &Pugs::Grammar::Rule::metasyntax;
  sub code       { Pugs::Grammar::Rule::code(@_) }
  sub literal    { Pugs::Grammar::Rule::literal(@_) }
  sub metasyntax { Pugs::Grammar::Rule::metasyntax(@_) }
  push @rule_terms, 'metasyntax';

*ws = Pugs::Compiler::RegexPerl5->compile(q(^((?:\\s|\\#(?-s:.)*)+)), { P5 => 0 })->code;
*variable = Pugs::Compiler::RegexPerl5->compile(q(^([\\$\\%\\@](?:(?:\\:\\:)?[_[:alnum:]]+)+)), { P5 => 0 })->code;
*positional_variable = Pugs::Compiler::RegexPerl5->compile(q(^([\\$\\%\\@]\\^(?:[_[:alnum:]]+))), { P5 => 0 })->code;
*ident = Pugs::Compiler::RegexPerl5->compile(q(^((?:(?:\\:\\:)?[_[:alnum:]]+)+)), { P5 => 0 })->code;
*num_variable = Pugs::Compiler::RegexPerl5->compile(q(^(?:\\$[[:digit:]]+)), { P5 => 0 })->code;
*dot = Pugs::Compiler::Regex->compile(q(
        \\.    
            
        { return { 'dot' => 1 ,} }
    ))->code;
*plain_text = Pugs::Compiler::Regex->compile(q(
        <alnum> | \\, | \\; | \\_ | \\/ | \\~ | \\" | \\' | \\=

        { return { 'constant' => $() ,} }
    ))->code;
*special_char = Pugs::Compiler::Regex->compile(q(
        \\\\ .

        { return { special_char => $(), } } 
    ))->code;
*non_capturing_group = Pugs::Compiler::Regex->compile(q(
        \\[ <rule> \\] 
         
        { return $_[0]{rule}() }
    ))->code;
*closure_rule = Pugs::Compiler::Regex->compile(q(
        <code>
            
        { return { closure => $_[0]{code}() ,} }
    ))->code;
*variable_rule = Pugs::Compiler::Regex->compile(q(
        <variable> | <positional_variable>
            
        { return { variable => $() ,} }
    ))->code;
*match_variable = Pugs::Compiler::Regex->compile(q(
        <num_variable>    
            
        { return { match_variable => $_[0]{num_variable}() ,} }
    ))->code;
*named_capture_body = Pugs::Compiler::Regex->compile(q(
          [ \\( <rule> \\) { return { rule => $_[0]{rule}(), } } ]
        | [ \\[ <rule> \\] { return { rule => $_[0]{rule}(), } } ]
        | [ <metasyntax> { return { rule => $_[0]{metasyntax}(), } } ]
    ))->code;
*named_capture = Pugs::Compiler::Regex->compile(q(
        \\$ \\< <ident> \\> <?ws>? \\:\\= <?ws>? <named_capture_body>
        
        { my $body = $_[0]{named_capture_body}();
          $body->{ident} = $_[0]{ident}();
          return { named_capture => $body, } 
        }
    ))->code;
*before = Pugs::Compiler::Regex->compile(q(
        \\< before <?ws> <rule> \\> 
        
        { return { before => {
                rule  => $_[0]{rule}(),
            }, } 
        }
    ))->code;
*after = Pugs::Compiler::Regex->compile(q(
        \\< after <?ws> <rule> \\> 
        
        { return { after => {
                rule  => $_[0]{rule}(),
            }, } 
        }
    ))->code;
*capturing_group = Pugs::Compiler::Regex->compile(q(
        \\( <rule> \\)
            
        { return { capturing_group => $_[0]{rule}() ,} }
    ))->code;
*colon = Pugs::Compiler::Regex->compile(q(
        ( 
            [ \\:\\:\\: ] | 
            [ \\:\\? ]   | 
            [ \\:\\+ ]   | 
            [ \\:\\: ]   | \\: |
            [ \\$\\$ ]   | \\$ |
            [ \\^\\^ ]   | \\^
        )
            
        { return { colon => $_[0]->() ,} }
    ))->code;
*quantifier = Pugs::Compiler::Regex->compile(q(
    $<ws1>   := (<?ws>?)
    $<term>  := (<@Pugs::Grammar::P6Rule::rule_terms>)
    $<ws2>   := (<?ws>?)
    $<quant> := (
        [ 
            [ \\?\\? ] |
            [ \\*\\? ] |
            [ \\+\\? ] |
            \\?       |
            \\*       |
            \\+
        ]?
    )
    $<ws3>   := (<?ws>?)
    
    { return {  
            term  => $_[0]{term}(),
            quant => $_[0]{quant}(),
            ws1   => $_[0]{ws1}(),
            ws2   => $_[0]{ws2}(),
            ws3   => $_[0]{ws3}(),
        } 
    }
))->code;
*concat = Pugs::Compiler::Regex->compile(q(
    $<q1> := (<quantifier>) 
    [
        $<q2> := (<concat>) 
        
        { return { concat => [ 
                { quant => $_[0]{q1}() ,}, 
                $_[0]{q2}(),
            ] ,} 
        } 
    |    
        { return { quant => $_[0]{q1}() ,} } 
    ]
))->code;
*rule = Pugs::Compiler::Regex->compile(q(
    $<q1> := (<concat>) 
    [
        $<q2> := (<rule>) 

        { return { alt => [ 
                $_[0]{q1}(), 
                $_[0]{q2}(),
            ] ,} 
        }
    |           
        { return $_[0]{q1}() } 
    ]
))->code;

unshift @rule_terms, 'dot';
unshift @rule_terms, 'plain_text';
unshift @rule_terms, 'special_char';
push @rule_terms, 'non_capturing_group';
unshift @rule_terms, 'closure_rule';
unshift @rule_terms, 'variable_rule';
unshift @rule_terms, 'match_variable';
unshift @rule_terms, 'named_capture';
unshift @rule_terms, 'before';
unshift @rule_terms, 'after';
unshift @rule_terms, 'capturing_group';
push @rule_terms, 'colon';

    # XXX - currying should be made automatically by <@xxx> runtime
    # curry @rule_terms with Grammar
    @rule_terms = map { 
        my $method = $_;
        sub{ 
            # warn "Trying $method\n";
            my $match = Pugs::Grammar::Rule->$method(@_);
            #warn "Match $method ".Dumper($match) if $match->{bool};
            return $match;
        }
    }
    @rule_terms;

1;