# pX/Common/p6rule_lib.pl - fglock
#
# native library for the experimental implementation of p6-regex parser
#
# see: README


# XXX - rename the system grammar to 'Grammar'
# XXX - use method calls
#   <audreyt> because all grammars inherits from Grammar
#   <fglock> re inheritance - p5 rule calls will need to be written like methods 
#            for this to work

{
  package grammar1;

  use Text::Balanced; 

sub any { 
    return unless $_[0];
    return { 
        bool  => 1,
        match => { '.'=> substr($_[0],0,1) },
        tail  => substr($_[0],1),
        ( $_[2]->{capture} ? ( capture => [ substr($_[0],0,1) ] ) : () ),
    };
}
sub ws {
    return unless $_[0];
    return { 
        bool  => 1,
        match => { 'ws'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^(\s+)(.*)$/s;
    return;
};
sub p6ws {
    return unless $_[0];
    return { 
        bool  => 1,
        match => { 'p6ws'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^((?:\s|\#(?-s:.)*)+)(.*)$/s;
    return;
};
sub newline {
    return unless $_[0];
    return { 
        bool  => 1,
        match => { 'newline'=> $1 },
        tail  => substr($_[0],1),
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^(\n)/s;
    return;
};
sub escaped_char {
    return unless $_[0];
    return { 
        bool  => 1,
        match => { 'escaped_char'=> $1 },
        tail  => substr($_[0],2),
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^\\(.)/s;
    return;
};

# ----- the following were included only for performance reasons,
# because they are too frequent and they are too slow using the basic 
# rule parser

sub code {
    return unless $_[0];
    ($extracted,$remainder) = Text::Balanced::extract_codeblock( $_[0] );
    return { 
        bool  => ( $extracted ne '' ),
        match => $extracted,
        tail  => $remainder,
        ( $_[2]->{capture} ? ( capture => [ $extracted ] ) : () ),
    };
}

sub literal {
    return unless $_[0];
    ($extracted,$remainder) = Text::Balanced::extract_delimited( $_[0], "'" );
    $extracted = substr( $extracted, 1, -1 );
    return { 
        bool  => ( $extracted ne '' ),
        match => $extracted,
        tail  => $remainder,
        ( $_[2]->{capture} ? ( capture => [ { literal => $extracted } ] ) : () ),
    };
}

sub ws_star {
    #return unless $_[0];
    return { 
        bool  => 1,
        match => { 'ws*'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^(\s*)(.*)$/s;
    return;
};
sub p6ws_star {
    #return unless $_[0];
    return { 
        bool  => 1,
        match => { 'p6ws*'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => [ $1 ] ) : () ),
    }
        if $_[0] =~ /^((?:\s|\#(?-s:.)*)*)(.*)$/s;
    return;
};

sub variable {
    #return unless $_[0];
    return { 
        bool  => 1,
        match => { 'ws*'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => $1 ) : () ),
    }
        if $_[0] =~ / ^  
            (   [ $ % @ % ]
                (?: 
                    (?:\:\:)? 
                    [_[:alnum:]]+ 
                )+
            )  
            (.*) $ /xs;
    return;
};

sub ident {
    #return unless $_[0];
    return { 
        bool  => 1,
        match => { 'ident'=> $1 },
        tail  => $2,
        ( $_[2]->{capture} ? ( capture => [ { ident => $1 } ] ) : () ),
    }
        if $_[0] =~ / ^  
            ( 
                (?: 
                    (?:\:\:)? 
                    [_[:alnum:]]+ 
                )+
            )  
            (.*) $ /xs;
    return;
};

}

1;