package Parse::Eyapp::TokenGen;
use strict;
use warnings;

eval { require Test::LectroTest::Generator };
die "Please, install Test::LectroTest from CPAN\n" if $@;
Test::LectroTest::Generator->import(qw(:all));

use Scalar::Util qw{reftype looks_like_number};

# Arguments: probabilities and generators
sub LexerGen {
  my $parser = shift;

  my $tg = sub {
    Frequency( map { [$parser->token_weight($_), Unit($_)] } @_);
  };

  $parser->set_tokenweightsandgenerators(@_);

  $parser->YYLexer(sub {
      my $parser = shift;

      my @token = $parser->YYExpect; # the list of token that can be expected 

      # Generate on of those using the token_weight distribution
      my $tokengen = $tg->(@token);

      my $token = $tokengen->generate();

      my $gen = $parser->token_generator($token);

      my $attr = $gen->generate();

      return ($token, $attr);
    }
  );
}

sub generate {
  my $gen = shift;
  my %args = @_;

  #TODO: check for existence of arg yylex or set to reasonable defaults
  if (exists($args{yylex}) && (reftype($args{yylex}) eq 'HASH')) {
    my %lexargs = %{$args{yylex}};
    $args{yylex} = $gen->LexerGen(%lexargs);
  }

  return $gen->YYParse(%args);
}

sub set_tokengens {
  my $parser = shift;

  my %g = @_;
  my $terms = $parser->{TERMS};
  for (keys %g) {
    # Check if $_is a token?
    $terms->{$_}{GENERATOR} = $g{$_};
  }
}

sub set_tokenweights {
  my $parser = shift;

  my %weight = @_;
  my $terms = $parser->{TERMS};
  for (keys %weight) {
    # Check if $_is a token?
    $terms->{$_}{WEIGHT} = $weight{$_};
  }
}

sub set_tokenweightsandgenerators {
  my $parser = shift;
  my %par = @_;

  my $terms = $parser->{TERMS};
  for (keys %par) {
    my $t = $terms->{$_};

    if (reftype($par{$_}) && (reftype($par{$_}) eq 'ARRAY')) {
      ($t->{WEIGHT}, $t->{GENERATOR}) = @{$par{$_}};
      next;
    }

    if (looks_like_number($par{$_})) {
      if ($par{$_} < 0) {
        warn "Warning: set_weights_and_generators: negative weight ($par{$_}) for token <$_>\n"; 
      }
      ($t->{WEIGHT}, $t->{GENERATOR})  = ($par{$_}, Unit($_));
      next;
    }

    warn "Warning: set_weights_and_generators: unexpected param <$par{$_}> for token <$_>\n";
  }
}

sub token_weight {
  my $parser = shift;
  my $token = shift;
  my $weight = shift;

  $parser->{TERMS}{$token}{WEIGHT} = $weight if $weight && looks_like_number($weight);
  $parser->{TERMS}{$token}{WEIGHT};
}

sub token_generator {
  my $parser = shift;
  my $token = shift;
  my $generator = shift;

  $parser->{TERMS}{$token}{GENERATOR} = $generator if $generator;
  $parser->{TERMS}{$token}{GENERATOR};
}

sub deltaweight {
  my $parser = shift;

  my %delta = @_;

  for my $token (keys(%delta)) {
    my $t = $parser->{TERMS}{$token};
    $t->{WEIGHT} += $delta{$token} if looks_like_number($delta{$token});
    $t->{WEIGHT} = 0 if $t->{WEIGHT} < 0;
  }
}

sub pushdeltaweight {
  my $parser = shift;

  my %d = @_;
  my $weightstack = $parser->{WEIGHTSTACK};
  my $term = $parser->{TERMS};
  %d = map { $_ => $term->{$_}{WEIGHT} } keys %d;
  push @$weightstack, \%d;
  $parser->deltaweight(@_);
}

sub popweight {
  my $parser = shift;

  my $w = pop @{$parser->{WEIGHTSTACK}};

  my $term = $parser->{TERMS};
  for my $token (keys %$w) {
    $term->{$token}{WEIGHT} = $w->{$token};
  }
}

1;