src/add-affixes

   1 #!/usr/bin/perl
   2
   3 $inc_level = 0;
   4 if ($ARGV[0] ne '') {
   5   $inc_level = $ARGV[0];
   6 }
   7
   8 print STDERR "Include Level: $inc_level\n";
   9
  10 if ($ARGV[1] eq 'use-all') {
  11
  12   print STDERR "Skipping Remove List\n";
  13
  14 } else {
  15
  16   open F, "r/alt12dicts/2of12id.txt" or die;
  17
  18   while (<F>) {
  19     s/\r?\n$// or die;
  20     ($d,$w,$p,$a) = /^(\-?)(\w+) (.).*: ?(.*)$/ or die;
  21     my @a = $a =~ /([~@-]*\w+)/g;
  22     @a = map {"$d$_"} @a if ($d);
  23     my (@a0,@a1);
  24     foreach (@a) {if (s/^[~-]//) {push @a0, $_} else {push @a1, $_}}
  25     $remove{"$w:$p"} = 1 unless @a1;
  26     foreach (@a0) {$remove{"$w:$p:$_"} = 1}
  27   }
  28 }
  29
  30 open F, "r/infl/infl.txt" or die;
  31
  32 while (<F>) {
  33   ($w,$p,$a) = /(\S+) (.).*: (.+)/ or die;
  34   next if $remove{"$w:$p"};
  35   @a = split /, | \| /, $a;
  36   @a = grep {my ($word,$tags,$level)
  37                  = /^([A-Za-z\']+)([~<!?]*)(| [\d.]+)(| {\S+})$/ or die $_;
  38              $_ = $word;
  39              $tags !~ /~|\?|!</ && $level <= $inc_level} @a;
  40   @a = grep {not $remove{"$w:$p:$_"}} @a;
  41   next unless @a;
  42   $lookup{$w} .= join("\n",@a)."\n";
  43 }
  44
  45 while (<STDIN>) {
  46   print;
  47   chop;
  48   print $lookup{$_};
  49 }