view release on metacpan or  search on metacpan

t/hop.t  view on Meta::CPAN

# -*- Mode: Python -*-

# These are Pythonic ports of programs from MJD's HOP.

# Acme::Pythonic needs to know this prototype.
sub Iterator(&);

use Test::More 'no_plan';
use Acme::Pythonic debug => 0;

use strict
use warnings

my ($it, $computed, $expected)


#
# ---[ Chapter 1: Recursion ]-------------------------------------------
#

# This is hanoi() from page 9 plus a variation of check_move from pages
# 10 and 11 that constructs a list for testing instead of printing
# messages.

my @position = ('', ('A') x 3) # Disks are all initially on peg A

sub check_move:
    my $i
    my ($disk, $start, $end) = @_
    if $disk < 1 || $disk > $#position:
        die "Bad disk number $disk. Should be 1..$#position.\n"
    unless $position[$disk] eq $start:
        die "Tried to move disk $disk from $start, but it is on peg $position[$disk].\n"
    for $i in 1 .. $disk-1:
        if $position[$i] eq $start:
            die "Can't move disk $disk from $start because $i is on top of it.\n"
        elsif $position[$i] eq $end:
            die "Can't move disk $disk to $end because $i is already there.\n"
    push @$computed, [$disk, $start, $end]
    $position[$disk] = $end

sub hanoi:
    my ($n, $start, $end, $extra, $move_disk) = @_
    if $n == 1:
        $move_disk->(1, $start, $end)
    else:
        hanoi($n-1, $start, $extra, $end, $move_disk)
        $move_disk->($n, $start, $end)
        hanoi($n-1, $extra, $end, $start, $move_disk)

hanoi(3, 'A', 'C', 'B', \&check_move)
is_deeply($computed, [[1, 'A', 'C'],
                      [2, 'A', 'B'],
                      [1, 'C', 'B'],
                      [3, 'A', 'C'],
                      [1, 'B', 'A'],
                      [2, 'B', 'C'],
                      [1, 'A', 'C']])


#
# ---[ Chapter 4: Iterators ]-------------------------------------------
#

# Defined on page 121
sub upto:
    my ($mx, $nx) = @_
    return sub:
        return $mx <= $nx ? $mx++ : undef

$it = upto 2, 5
my $n = 2
while defined(my $val = $it->()):
    is $val, $n++
is $n, 6

# Defined on page 122
sub NEXTVAL:
    $_[0]->()

# Defined on page 123
sub Iterator(&):
    return $_[0]

# Defined on page 160
sub imap(&$):
    my ($transform, $it) = @_
    return Iterator:
        local $_ = NEXTVAL($it)
        return unless defined $_
        return $transform->()

$it = imap:
         $_ *= 2
         $_ += 1
         $_
      upto(2, 5)

$expected = [5, 7, 9, 11]
$computed = []
while my $val = NEXTVAL($it):
    push @$computed, $val
is_deeply $expected, $computed

# Defined on page 160
sub igrep(&$):
    my ($is_interesting, $it) = @_
    return Iterator:
        local $_