Acme-Pythonic

 view release on metacpan or  search on metacpan

lib/Acme/Pythonic.pm  view on Meta::CPAN

    # If unsure about the ending indentation level, add an extra
    # non-indented line to ensure the stack gets emptied.
    push @lines, '1; # added by Acme::Pythonic' if $lines[-1] =~ /^(?:\s|\s*#)/;

    my ($comment,             # comment in the current line, if any
        $indent,              # indentation of the current logical line
        $id_at_sob,           # identifier at StartOfBlock, for instance "else", or "eval"
        $prev_line_with_code, # previous line with code
        $might_be_modifier,   # flag: current logical line might be a modifier
        $line_with_modifier,  # physical line which started the current modifier
        $joining,             # flag: are we joining lines?
        $unbalanced_paren,    # flag: we opened a paren that remains to be closed
        @stack,               # keeps track of indentation stuff
    );

    @stack = ();
    foreach my $line (@lines) {
        # We remove any trailing comment so that we can assert stuff
        # easily about the end of the code in this line. It is later
        # appended back in the continue block below.

lib/Acme/Pythonic.pm  view on Meta::CPAN

        # We are not sure whether this is a for or a foreach, but it is
        # very likely that putting parens around gets it right.
        $rest =~ s/^\s*in\b//; # fixes "foreach in LIST"
        $guess = "$for($rest";
    }

    return $guess;
}


# Guesses whether a block started by $id_at_sob needs a semicolon after the
# ending bracket.
sub needs_semicolon {
    my $id_at_sob = shift;
    return 0 if !$id_at_sob;
    return 1 if $id_at_sob =~ /^(do|sub|eval)$/;

    my $proto = $id_at_sob =~ /::/ ? prototype($id_at_sob) : prototype("${CALLER}::$id_at_sob");
    return 0 if not defined $proto;
    return $proto =~ /^;?&$/;
}

lib/Acme/Pythonic.pm  view on Meta::CPAN

        for my $wid (@ary1) {               # NOT WHAT WE WANT
            INNER:
            for my $jet (@ary2) {           # GOOD, ALIGNED
                next OUTER if $wid > $jet;
                $wid += $jet;
            }
        }
    }

The consequence is that C<next OUTER> goes outside the outer for loop and thus
it is restarted, instead of continued.

=head2 C<do/while>-like constructs

Acme::Pythonic tries to detect statement modifiers after a C<do BLOCK>. Thus

    do:
        do_something()
        do_something_else()
    while $condition

lib/Acme/Pythonic.pm  view on Meta::CPAN

Acme::Pythonic generates human readable Perl following L<perlstyle>, and
tries meticulously to be respectful with the original source code.
Blank lines and comments are preserved.


=head1 BUGS

This module uses a regexp approach and the superb help of
Filter::Simple. The regexp part of this means it is broken from the
start, though I've tried hard to make it as robust as I could. Bug
reports will be very welcome, just drop me a line!


=head1 THANKS

Damian Conway gave his full blessing if I wanted to write a module like
this based on his unpublished Language::Pythonesque. The code that
handles indentation is inspired by his.

Also, Dr. Conway is the author of L<Filter::Simple>, which aids a lot

t/hop.t  view on Meta::CPAN

#

# 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']])