package Inline::Spew;

require Inline;
require YAML;

our @ISA = qw(Inline);

sub register {
  return {
          language => 'Spew',
          type => 'interpreted',
          suffix => 'spew',
         };
}

sub validate {
}

sub build {
  my $o = shift;
  my $code = $o->{API}{code};
  my $location = "$o->{API}{location}";

  require File::Basename;
  my $directory = File::Basename::dirname($location);
  $o->mkpath($directory) unless -d $directory;

  my $spew = spew_compile($code);

  YAML::DumpFile($location, $spew);
}

sub load {
  my $o = shift;

  my $sub = do {
    my $s = $o->{CONFIG}{SUB} || "spew";
    unless ($s =~ /::/) {
      $s = $o->{API}{pkg}."::$s";
    }
    $s;
  };
  my $location = $o->{API}{location};
  my @result = YAML::LoadFile($location);

  {
    no strict 'refs';
    *$sub = sub {
      my $start = shift || "START";
      return spew_show($result[0], $start);
    };
  }
}

sub spew_show {
  my ($parsed, $defn) = @_;
  die "missing defn for $defn" unless exists $parsed->{$defn};

  my @choices = @{$parsed->{$defn}{is}};
  my $weight = 0;
  my @keeper = ();
  while (@choices) {
    my ($thisweight, @thisitem) = @{pop @choices};
    $thisweight = 0 if $thisweight < 0; # no funny stuff
    $weight += $thisweight;
    @keeper = @thisitem if rand($weight) < $thisweight;
  }
  my $result;
  for (@keeper) {
    ## should be a list of ids or defns
    die "huh $_ in $defn" if ref $defn;
    if (/^ (.*)/s) {
      $result .= $1;
    } elsif (/^(\w+)$/) {
      $result .= spew_show($parsed, $1);
    } else {
      die "Can't show $_ in $defn\n";
    }
  }
  return $result;
}

BEGIN {

  my $parser;
  my $GRAMMAR = q{

{ my %grammar; my $internal = 0; }

grammar: rule(s) /\Z/ { \%grammar; }

## rule returns identifier (not used)
rule: identifier ":" defn {
                push @{$grammar{$item[1]}{is}}, @{$item[3]};
                $grammar{$item[1]}{defined}{$itempos[1]{line}{to}}++;
                $item[1];
        }
        | <error>

## defn returns listref of choices
defn: <leftop: choice "|" choice>

## choice returns a listref of [weight => @items]
choice: weight unweightedchoice { [ $item[1] => @{$item[2]} ] }

## weight returns weight if present, 1 if not
weight: /\d+(\.\d+)?/ <commit> /\@/ { $item[1] } | { 1 }

## unweightedchoice returns a listref of @items
unweightedchoice: item(s)

## item returns " literal text" or "identifier"
item:
        { $_ = extract_quotelike($text) and " " . eval }
        | identifier <commit> ...!/:/ { # must not be followed by colon!
                $grammar{$item[1]}{used}{$itempos[1]{line}{to}}++;
                $item[1]; # non-leading space flags an identifier
        }
        | "(" defn ")" { # parens for recursion, gensym an internal
                ++$internal;
                push @{$grammar{$internal}{is}}, @{$item[2]};
                $internal;
        }
        | <error>

identifier: /[^\W\d]\w*/
};

  sub spew_compile {
    my $source = shift;

    unless ($parser) {
      require Parse::RecDescent;
      $parser = Parse::RecDescent->new($GRAMMAR) or die "internal bad";
    }

    my $parsed = $parser->grammar($source) or die "bad spew grammar";

    for my $id (sort keys %$parsed) {
      next if $id =~ /^\d+$/;       # skip internals
      my $id_ref = $parsed->{$id};
      unless (exists $id_ref->{defined}) {
        die "$id used in @{[sort keys %{$id_ref->{used}}]} but not defined";
      }
    }    

    return $parsed;
  }
}

1;
__END__
=head1 NAME

Inline::Spew - Inline module for Spew

[rest of pod deleted]