Port of http://blogs.perl.org/users/salvador_fandino/2012/03/solving-carl-masaks-counting-t4-configurations-problem-in-pure-perl-5.html

count_configurations.p6

my $tab = join "\n", <
    -----xxx
    ------xx
    x-----xx
    x------x
    xx-----x
    xx------
    xxx-----
>;

my $vertical = index $tab, "\n";
my $diagonal = $vertical + 1;

my %acu = $tab => 1;

my $vertical_xx = eval("/^ (. ** $vertical) '-'/");
my $vertical_xxx = eval("/^ (. ** $vertical 'x' . ** $vertical) '-'/");
my $diagonal_xx = eval("/^ (. ** $diagonal) '-'/");
my $diagonal_xxx = eval("/^ (. ** $diagonal 'x' . ** $diagonal) '-'/");

for ^$tab.chars {
    my %next;
    for %acu.kv -> $k, $c {
        my $s = $k.substr(0, 1);
        my $k0 = $k.substr(1);
        %next{$k0} += $c;
        next unless $s eq '-';
        my $k1 = $k0;
        if $k1.=subst(/^ '-'/, 'x') ne $k0 { # horizontal xx
            %next{$k1} += $c;
            my $k2 = $k1;
            if $k2.=subst(/^ 'x-'/, 'xx') ne $k1 { # horizontal xxx
                %next{$k2} += $c;
            }
        }
        $k1 = $k0;
        if $k1.=subst($vertical_xx,
                      -> $/ { $0 ~ 'x' }) ne $k0 { # vertical xx
            %next{$k1} += $c;
            my $k2 = $k1;
            if $k2.=subst($vertical_xxx,
                          -> $/ { $0 ~ 'x' }) ne $k1 { # vertical xxx
                %next{$k2} += $c;
            }
        }
        $k1 = $k0;
        if $k1.=subst($diagonal_xx,
                      -> $/ { $0 ~ 'x' }) ne $k0 { # diagonal xx
            %next{$k1} += $c;
            my $k2 = $k1;
            if $k2.=subst($diagonal_xxx,
                          -> $/ { $0 ~ 'x' }) ne $k1 { # diagonal xxx
                %next{$k2} += $c;
            }
        }
    }
    %acu := %next;
}

say "total: %acu.values()";

idiomatic_version.p6

my $tab = join "\n", <
    -----xxx
    ------xx
    x-----xx
    x------x
    xx-----x
    xx------
    xxx-----
>;

my $vertical = index $tab, "\n";
my $diagonal = $vertical + 1;

my %acu = $tab => 1;

sub make_substituter($rx) {
    return sub ($tab) {
        my $newtab = $tab;
        return $newtab
            if $newtab.=subst($rx, -> $/ { $0 ~ 'x' }) ne $tab;
    };
}

sub make_2x_substituter($rx) {
    return sub ($tab) {
        my $newtab = $tab;
        return $newtab
            if $newtab.=subst($rx, -> $/ { [~] $0, 'x', $1, 'x' }) ne $tab;
    };
}

my @pieces = 
    make_substituter(rx/^ ('') '-'/),
    make_substituter(eval("/^ ({'.' x $vertical}) '-'/")),
    make_substituter(eval("/^ ({'.' x $diagonal}) '-'/")),
    make_2x_substituter(rx/^ ('') '-' ('') '-'/),
    make_2x_substituter(eval("/^ ({'.' x $vertical}) '-' ({'.' x $vertical}) '-'/")),
    make_2x_substituter(eval("/^ ({'.' x $diagonal}) '-' ({'.' x $diagonal}) '-'/"));

for ^$tab.chars {
    my %next;
    for %acu.kv -> $k, $c {
        my $s = $k.substr(0, 1);
        my $k0 = $k.substr(1);
        %next{$k0} += $c;
        next unless $s eq '-';
        for @pieces -> &piece {
            if &piece($k0) -> $newtab {
                %next{$newtab} += $c;
            }
        }
    }
    %acu := %next;
}

say "total: %acu.values()";