#!/usr/bin/perl sub strip_plurel() { local $_ = $_[0]; my @l; push @l, "$1y" if /^(.+)[iI]es$/; push @l, $1 if /^(.+)es$/; push @l, $1 if /^(.+?)\'?s$/; return @l; } # STDIN contains the the list of words which contain the base forms while () { print unless $ARGV[1] eq "noecho"; chop; $lookup{$_} = 1; } # ARGV[0] is the file of words with possible 's's that we want to # extract provided the base from is was in the above list open IN, $ARGV[0] or die; while () { chop; my $print = 0; foreach $s (&strip_plurel($_)) { if (exists $lookup{$s}) { $print = 1; } } print "$_\n" if $print; }