use Carp qw(confess);


sub upto {
  my ($m, $n) = @_;
  return sub {
    return if $m > $n;
    return $m++;
  };
}

sub imap (&$) {
  my ($t, $i) = @_;
  my $DONE;
  return sub {
    my $v;
    if ($DONE || ! defined($v = $i->())) {
      $DONE = 1;
      return;
    }
    local $_ = $v;
    return $t->($v);
  };
}

        my $N = shift // 3;
        my $it = subsets_of_size_n([qw(A B C D E F)], $N);
# $it = imap { 2 * $_ } upto(3,7);
        while (my $s = $it->()) {
          print "@$s\n";
        } 
        exit;

        # iterate subsets of size k of elements of $S
        # It would be simpler to use imap {} upto(...) here.
        sub subsets_of_size_n {
          my ($S, $k) = @_;
          my $N = @$S;
          my $p = choose($N, $k)-1;
          imap { _select([vector($N, $k, $_)], $S) } upto(0, $p);
        }

        # Take a set of size N, and a vector of zeroes and ones of the
        # same size, and extract the corresponding elements from the
        # set
        sub _select {
          my ($selection, $S) = @_;
          return [ map { $selection->[$_] ? $S->[$_] : () } 0 .. $#$S ];
        }

        # This is the crucial algorithm
        #
        # Generate the $p'th vector of $n bits of which exactly $k are
        # ones (That is, each generated vector will be different for
        # each value of $p between 0 and ($n choose $k)-1.)

        sub vector {
          my ($n, $k, $p) = @_;
        #  warn "vector($n, $k, $p)\n";
          confess "p=$p out of range for ($n, $k)" if $p < 0 || $p >= choose($n, $k);
          return () if $n == 0;
          # Is the first bit 0 or 1?
          # Of the (n choose k) vectors, the first (n-1 choose k) begin with 0
          # and the remaining (n choose k) begin with 1
          my $first = 0 + ($p >= choose($n-1, $k));
          my @rest = vector($n-1, $k - $first, $first ?
                                     $p - choose($n-1, $k) : $p );
          return ($first, @rest);
        }

        # This calculates binomial coefficients in amortized constant time
        my @p;
        sub choose {
          my ($n, $k) = @_;
          return 0 if $n < 0 || $k < 0;
          my $row = $p[$n] ||= [1];
          until (@$row > $k) {
            my $kk = @$row;
            push @$row, choose($n-1, $kk-1) * $n / $kk;
          }
          return $row->[$k];
        }