#!/usr/bin/perl -s

use strict;
use warnings;
use Data::Dumper;

use Memoize;
use Lingua::Jspell;

use Text::RewriteRules;

use POSIX qw(locale_h);
setlocale(LC_CTYPE, "pt_PT");
use locale;


memoize('from_closed_class');

our $word = qr/\b\w+\b/;
our ($lang);
$lang ||= "port";

my $dic = Lingua::Jspell->new($lang);

$/="\n\$\n";
while(<>) {
    chomp;
    print glue($_);
    print "\n\$\n";
}







sub from_closed_class {
    my %cclasses;
    my $word = shift;
    if ($lang && $lang eq "eng") {
        %cclasses = qw!prep 1
                       con  1
                       pint 1
                       art  1
                       prel 1
                       p    1!;
        my %excep = qw!more 1
                       other 1
                       least 1
                       much 1
                       many 1
                       nothing 1
                       no 1!;

        return 1 if defined($excep{$word});
    } else {
        %cclasses = qw!ppos 1
                       prep 1
                       con  1
                       pint 1
                       pdem 1
                       pind 1
                       pass 1
                       art  1
                       prel 1
                       cp   1
                       ppes 1!;
    }

    my @analysis = $dic->fea($word);
    for my $analysis (@analysis) {
        return 1 if exists $cclasses{$analysis->{CAT}};
    }
    return 0;
}

sub are_closed_classes {
    for (@_) {
        return 0 if not from_closed_class($_);
    }
    return 1;
}



RULES/m glue
($word) ($word) ($word) ($word) ($word)==>$1_$2_$3_$4_$5!!are_closed_classes($1,$2,$3,$4,$5)
($word) ($word) ($word) ($word)==>$1_$2_$3_$4!!are_closed_classes($1,$2,$3,$4)
($word) ($word) ($word)==>$1_$2_$3!!are_closed_classes($1,$2,$3)
($word) ($word)==>$1_$2!!are_closed_classes($1,$2)
($word(-$word)*)==>$1
ENDRULES
