#!/usr/bin/perl -I/home/jkominek/lib/perl5

use strict;

#use Data::Dumper;
use Memoize;
use Carp;
#use Fcntl;
#use GDBM_File;

$|=1;

print "Content-type: text/plain\n\n";

print "Generating, please hold... (Note 1 to 5% of sentences aren't valid).\n\n";

#tie my %f_icache => 'GDBM_File', 'f_icache.db', O_RDWR|O_CREAT, 0644;
memoize('f_i',
	SCALAR_CACHE => ['MERGE']);
#	LIST_CACHE => [HASH => \%f_icache]);
#tie my %f_ijkcache => 'GDBM_File', 'f_ijkcache.db', O_RDWR|O_CREAT, 0644;
memoize('f_ijk',
	SCALAR_CACHE => ['MERGE']);
#	LIST_CACHE => [HASH => \%f_ijkcache]);

use strict;

my $delim=$/;
undef $/;
open(GRAMMAR,"grammar.300");
my $foo = <GRAMMAR>;
close(GRAMMAR);
$/=$delim;

my %words;
open(CMAVO,"cmavo");
while(<CMAVO>) {
  if(/^(.{10})(.{9})/) {
    my($cmavo,$selmaho)=($1,$2);
    $cmavo =~ s/\s+//g;
    $selmaho =~ s/\s+//g;
    $selmaho =~ s/\d+//g;
    next if $selmaho =~ /\*/;
    push @{$words{$selmaho}}, $cmavo;
  } else {
    print;
  }
}
close(CMAVO);
open(GISMU,"gismu");
while(<GISMU>) {
  if(/^(\w\w\w\w\w)/) {
    push @{$words{'BRIVLA'}}, $1;
  }
}
close(GISMU);
$words{'CMENE'} = ['djan.',
		   'margryt.',
		   'juLIET.',
		   'laudz.',
		   '.erkin.',
		   'fridrix.',
		   'klaras.',
		   '.izaBEL.',
		   ];

$foo =~ s#/\*.+?\*/##gs;

my(@tokens,%tokens);

if($foo =~ /^(.+?)%%/s) {
  my $tokendefs = $1;
  my @lines = split/\n/,$tokendefs;
  foreach my $line (@lines) {
    if($line =~ /^%(\w+) ([\w ]+)/) {
      push @tokens, split/\s+/,$2 if $1 ne 'start';
    }
  }
}
$foo =~ s/^.+?%%//s;
$foo =~ s/%%.+?$//s;

foreach my $token (@tokens) {
  $tokens{$token} = 1;
}

my(%grammar);

my @productions = split/;/,$foo;
foreach my $production (@productions) {
  $production =~ s/^\s+//g;
  $production =~ s/\s+$//g;
  if($production =~ /^(\S+)\s*:\s+(.+)/s) {
    my $productionname = $1;
    my @subproductions = split/\s*\|\s*/,$2;
    foreach my $subproduction (@subproductions) {
      #$subproduction = s/^\s+//;
      if( ($subproduction !~ /error/) ) {
	push @{$grammar{$productionname}}, [split/\s+/,$subproduction];
      } else {
	#print "discard: $subproduction\n";
      }
    }
  }
}

#foreach my $production (keys %grammar) {
#  @{$grammar{$production}} =
#    sort { scalar @{$a} <=> scalar @{$b} } @{$grammar{$production}};
#}

#print Dumper(\%grammar);

sub s {
  my $i = shift;

  return scalar @{$grammar{$i}};
}

sub t {
  my $i = shift;
  my $j = shift;

  return scalar @{$grammar{$i}->[$j-1]};
}

sub x {
  my $i = shift;
  my $j = shift;
  my $k = shift;

  return $grammar{$i}->[$j-1]->[$k-1];
}

sub f_i {
  my $n = shift;
  my $i = shift;

#  print "f_i($n,$i)\n";

  my @tmp;
  for(my $j=1; $j<=&s($i); $j++) {
    push @tmp, sum(f_ijk($n,$i,$j,1));
  }
  return @tmp;
}

sub f_ijk {
  my $n = shift;
  my $i = shift;
  my $j = shift;
  my $k = shift;

#  print "f_ijk($n,$i,$j,$k)\n";

  if($n==0) {
    return ();
  }
  if(defined($tokens{ &x($i,$j,$k) })) {
#    print " terminal symbol\n";
    if($k==&t($i,$j)) {
      if($n==0) {
	return (0);
      } else {
	return (1);
      }
    } else {
      return sum(f_ijk($n-1,$i,$j,$k+1));
    }
  } else {
#    print " non-terminal symbol\n";
    if($k==&t($i,$j)) {
      return sum(f_i($n,&x($i,$j,$k)));
    } else {
      my @tmp;
      for(my $l=1; $l<=($n-&t($i,$j)+$k); $l++) {
	push @tmp, (sum(f_i(($l), &x($i,$j,$k))) *
		    sum(f_ijk($n-$l, $i, $j, $k+1)));
      }
      return @tmp;
    }
  }
}

sub sum {
  my $tmp = 0;
  foreach my $foo (@_) {
    $tmp += $foo;
  }
  return $tmp;
}

sub choose {
  my @l = @_;
#  print "choosing from: @l\n";
  my $total = sum(@l);
  my $n = rand(1);
  my $i;
  for($i=0; $i<=$#l; $i++) {
    confess "about to divide by zero" if $total==0.0;
    my $weight = $l[$i]/$total;
    if($n<$weight) {
      return $i+1;
    }
    $n = $n - $weight;
  }
  die "choose failed!";
}

sub g_i {
  my $n = shift;
  my $i = shift;

  my $r = &choose(f_i($n,$i));
  return g_ijk($n,$i,$r,1);
}

sub g_ijk {
  my $n = shift;
  my $i = shift;
  my $j = shift;
  my $k = shift;

  if(defined($tokens{ &x($i,$j,$k) })) {
    if($k==&t($i,$j)) {
      return &x($i,$j,$k);
    } else {
      return (&x($i,$j,$k),
	      g_ijk($n-1,$i,$j,$k+1));
    }
  } else {
    if($k==&t($i,$j)) {
      return g_i($n,&x($i,$j,$k));
    } else {
      my $l = choose(f_ijk($n,$i,$j,$k));
      return (g_i($l,&x($i,$j,$k)),
	      g_ijk($n-$l,$i,$j,$k+1));
    }
  }
}

foreach(1..100) {
  my @sentence = g_i(10,'statement_11');
  my $sentence;
  for(my $word=0; $word<=$#sentence; $word++) {
    if($sentence[$word] =~ /^lexer/) {
      splice @sentence, $word, 1;
      $word--;
      next;
#      $sentence .= $sentence[$word] . " ";
    } else {
      $sentence[$word] =~ s/_\d+$//;
      my $replacement = &findword($sentence[$word]);
      $sentence .= "$replacement ";
    }
  }
  $sentence =~ s/\s+$//g;
  $sentence =~ s/\s+vau$//g;
  $sentence .= "\n";
#  open(JBOFIHE,"|jbofihe>/dev/null");
  print $sentence;
#  print JBOFIHE $sentence;
#  close(JBOFIHE);
}

sub randword {
  my @tmp;
  foreach my $type (keys %words) {
    push @tmp, @{$words{$type}};
  }
  return $tmp[rand @tmp];
}

sub randwords {
  my $count = shift;
  my @tmp;
  foreach my $type (keys %words) {
    push @tmp, @{$words{$type}};
  }
  my @bar;
  while($count--) {
    push @bar, $tmp[rand @tmp];
  }
  return join(" ",@bar);
}

sub findword {
  my $type = shift;
  if($type =~ /^any/) {
    if($type eq 'any_words') {
      return &randword;
    } elsif($type eq 'any_word') {
      return &randwords(int(rand(5)+1));
    } elsif($type eq 'anything') {
      return "alsjhasdfkjhasd";
    }
  }
  if(!defined($words{$type})) {
    die "No words of $type!";
  }
  my @choices = @{ $words{$type} };
  return $choices[rand @choices];
}