m{
    (\w) \1
    (?! \1) (\w)
  }x;

##</code><code>##

  m{
    (\w) \1
    (?! \1) (\w)
    (?! \1 | \2) (\w) \3 \3 \3 \1
    (?! \1 | \2 | \3) (\w)
  }x;

##</code><code>##

my $s = 'AABCCCCAD';
our $DEBUG = 1;
print +($s =~ mkre($s)) ? "ok\n" : "fail\n";

sub mkre {
  my $s = shift;
  my $index = 0;
  my(%seen, @elems);
  for (split //, $s) {
    if ($seen{$_}) {
      push @elems, "\\$seen{$_}";
    } else {
      push @elems, sprintf '(?! %s)', join ' | ', map "\\$_", 1 .. $index
          if $index;
      $seen{$_} = ++$index;
      push @elems, '(\\w)';
    }
  }
  my $re = join ' ', @elems;
  warn "$s: $re\n" if $DEBUG;
  qr/$re/x;
}