use Algorithm::Loops qw( NestedLoops );
sub a {
#        1         2         3         4         5         6         7         8
#2345678901234567890123456789012345678901234567890123456789012345678901234567890

my$w=shift;my@x=sort$w=~/\w/g;my@d=@_;my$i=sub{$^=pop;my$i=NestedLoops([map{my$x=$d[$@[$_]];[grep{$x->[$_]!~/[^$w]/}0..$#{$x}]}1..$^ ]);while(@%=&$i){my@f=sort map{$d[$@[$_]][$%[$_-1]]}1..$^;$.[@.]="@f"if"@{[sort map{/./g}@f]}"eq"@x"}};my$p;$p=sub{my($n,$k,$t)=@_;$@[$t]=$k;$n-$k?map{$p->($n-$k,$_,$t+1)}reverse 1..(2*$k<$n?$k:$n-$k):&$i($t)};&$p(2*@x,1*@x,0);@.
}

open (my $dict, "/usr/dict/words") || die "No words\n";
my @dict;
push @{$dict[length $_]}, $_ for
    grep { length > 1 || $_ eq 'a' || $_ eq 'i' }
    grep { lc eq $_ }
    grep { chomp } <$dict>;
close ($dict);

print "$_\n" for a( 'together', @dict);