sub make_suffix_appender {
        my $suffix = shift;
        return sub {
            return $_[0] . $suffix;
        }
    }

##</code><code>##

    my $bang_appender = make_suffix_appender("!");
    print $bang_appender->("Hello");  # Hello!
    print $bang_appender->("Dude");   # Dude!

##</code><code>##

    sub apply {
        my $fn = shift;
        return sub {
            $fn->(@_);
        }
    }

    sub apply_to_each {
        my $fn = shift;
        return sub {
            map { $fn->($_) } @_;
        }
    }

##</code><code>##

    my $upcase = apply( sub { uc("@_") } );
    print $upcase->("Hello");           # HELLO
    print $upcase->("Hello", "world");  # HELLO WORLD

    my $parenify_all  = apply( sub { "(@_)" } );
    my $parenify_each = apply_to_each( $parenify_all );
    print $parenify_all ->("Hello", "world");  # (Hello world)
    print $parenify_each->("Hello", "world");  # (Hello)(world)

##</code><code>##

    sub make_regex_matcher {
        my $regex = shift;
        return sub {
            local $_ = $_[0];
            /$regex/g;
        }
    }

##</code><code>##

    my $digit_matcher = make_regex_matcher( qr/(\d+)/ );
    my @digits = $digit_matcher->( "123-blah-45-6789" );
    print "@digits";  # 123 45 6789

    my $word_matcher = make_regex_matcher( qr/(\w+)/ );
    my @words = $word_matcher->( "123-blah-45-6789" );
    print "@words";  # 123 blah 45 6789

##</code><code>##

    sub compose2 {
        my ($f, $g) = @_;
        return sub {
            $f->( $g->( @_ ) );
        }
    };

    use List::Util qw( reduce );
    sub compose {
        no warnings qw( once );
        reduce { compose2($a,$b) } @_;
    }

##</code><code>##

    my $up_banger = compose($bang_appender, $upcase);
    print $up_banger->("Hello");  # HELLO!

    my $upcase_words = compose($upcase, $word_matcher);
    print $upcase_words->( "123-blah-45-6789" );
        # 123 BLAH 45 6789

    my $parenify_words = compose($parenify_each, $word_matcher);
    print $parenify_words->( "123-blah-45-6789" );
        # (123)(blah)(45)(6789)

##</code><code>##

    print compose($parenify_each, $word_matcher)->("a b c");
        # (a)(b)(c)

##</code><code>##

    print compose($word_matcher, $parenify_each)->("a b c");
        # abc

##</code><code>##

    my $id = sub { wantarray ? @_ : $_[0] };

##</code><code>##

    my $fs = 0;
    for my $f ($id, $parenify_all, $parenify_each) {
        my $fd = (qw( id- pAl pEa ))[$fs++];
        my $gs = 0;
        for my $g ($id, $word_matcher, $digit_matcher) {
            my $gd = (qw( id- wrd dig ))[$gs++];
            my $hs = 0;
            for my $h ($id, $upcase, $bang_appender) {
                my $hd = (qw( id- up- bng ))[$hs++];
                print "$fd-$gd-$hd: ",
                      compose($f,$g,$h)->("Eat more 3.14");
            }
        }
    }

##</code><code>##

    id--id--id-: Eat more 3.14
    id--id--up-: EAT MORE 3.14
    id--id--bng: Eat more 3.14!
    id--wrd-id-: Eatmore314
    id--wrd-up-: EATMORE314
    id--wrd-bng: Eatmore314
    id--dig-id-: 314
    id--dig-up-: 314
    id--dig-bng: 314
    pAl-id--id-: (Eat more 3.14)
    pAl-id--up-: (EAT MORE 3.14)
    pAl-id--bng: (Eat more 3.14!)
    pAl-wrd-id-: (Eat more 3 14)
    pAl-wrd-up-: (EAT MORE 3 14)
    pAl-wrd-bng: (Eat more 3 14)
    pAl-dig-id-: (3 14)
    pAl-dig-up-: (3 14)
    pAl-dig-bng: (3 14)
    pEa-id--id-: (Eat more 3.14)
    pEa-id--up-: (EAT MORE 3.14)
    pEa-id--bng: (Eat more 3.14!)
    pEa-wrd-id-: (Eat)(more)(3)(14)
    pEa-wrd-up-: (EAT)(MORE)(3)(14)
    pEa-wrd-bng: (Eat)(more)(3)(14)
    pEa-dig-id-: (3)(14)
    pEa-dig-up-: (3)(14)
    pEa-dig-bng: (3)(14)