package Pugs::Grammar::Operator;
use strict;
use warnings;
use base qw(Pugs::Grammar::BaseCategory);
use Pugs::Grammar::Precedence;

use Data::Dumper;

our $operator;

# TODO - implement the "magic hash" dispatcher
our %hash;

#our @subroutine_names;

BEGIN {
    $operator = Pugs::Grammar::Precedence->new( 
        grammar => 'Pugs::Grammar::Operator',
        header  => q!
  
exp: 
      NUM                 
        { $_[0]->{out} = $_[1] }

    | BAREWORD
        { $_[0]->{out} = {  op1    => 'call', 
                            sub    => $_[1], } }
    | BAREWORD exp       %prec P001
        { $_[0]->{out} = {  op1    => 'call', 
                            sub    => $_[1], 
                            param  => $_[2], } }
 
    | REDUCE exp         %prec P001
        { $_[0]->{out} = {  %{$_[1]}, 
                            param  => $_[2], } }
       
    | DOT_BAREWORD exp   %prec P001
        { $_[0]->{out} = {  op1    => 'method_call', 
                            self   => { 'scalar' => '$_' }, 
                            method => $_[1], 
                            param  => $_[2], } }
    | DOT_BAREWORD   
        { $_[0]->{out} = {  op1    => 'method_call', 
                            self   => { 'scalar' => '$_' }, 
                            method => $_[1], } }

!,
    );
    #print "created operator table\n";
}

sub add_rule {
    # print "add operator\n";
    my $self = shift;
    my %opt = @_;
    #print "Operator add: @{[ %opt ]} \n";

    delete $opt{rule};
    $operator->add_op( \%opt );
    
    #push @subroutine_names, $opt{name};
}

use Pugs::Grammar::Infix;
use Pugs::Grammar::Prefix;
use Pugs::Grammar::Postfix;
use Pugs::Grammar::Circumfix;
use Pugs::Grammar::Postcircumfix;
use Pugs::Grammar::Ternary;

sub recompile {
    my $class = shift;

    # tokenizer
    %hash = (
        %Pugs::Grammar::Infix::hash,
        %Pugs::Grammar::Prefix::hash,
        %Pugs::Grammar::Postfix::hash,
        %Pugs::Grammar::Circumfix::hash,
        %Pugs::Grammar::Postcircumfix::hash,
        %Pugs::Grammar::Ternary::hash,
    );
    #print "Operator: Hash keys: @{[ keys %hash ]}\n";
    $class->SUPER::recompile;

    {
        #no warnings 'recursion'; # doesn't seem to work here
        local $SIG{'__WARN__'} =
            sub { 
                warn $_[0] if $_[0] !~ /recursion/ 
            };
        #warn 'compiling grammar';
        # operator-precedence
        my $g = $operator->emit_yapp;
        #print "Operator: Yapp grammar: \n", $g;
        my $p;
        $p = $operator->emit_grammar_perl5;
        # $p contains 'Pugs::Grammar::Operator::new()'
        # which calls 'Parse::Yapp::Driver::new()'

        # *** cache initialization data to a global var
        #print "Operator: Yapp grammar: \n" . $p;
        #print "Operator: Yapp grammar: \n" . substr( $p, length($p)-1000 );
        my ( $start, $data, $tail ) = $p =~ /^(.*?) ( yyversion .* \] ) (.*?)$/xs;
        #print "Operator: Yapp grammar: \n" . "$start \%yapp_data $tail";
        our %yapp_data = eval $data;
        eval $start . '%yapp_data' . $tail;
        #eval $p;   
        #warn 'compiled grammar';
    }
}

BEGIN {
    __PACKAGE__->recompile;
}

1;