File Coverage

blib/lib/Perl6/Controls.pm

Criterion	Covered	Total	%
statement	201	305	65.9
branch	16	32	50.0
condition	14	28	50.0
subroutine	35	35	100.0
pod			n/a
total	266	400	66.5

package Perl6::Controls;

use 5.014; use warnings;

our $VERSION = '0.000005';


use Keyword::Declare;

sub import {

    # Rewire the 'for' loop (but we need to handle existing usages first)...

    keyword for {{{ foreach }}}

    keytype OptIter is /(?:my|our|state)\s*\$\w+/;

    keyword for (OptIter $iter = '', '(', '^', Int $max, ')') {{{ for <{$iter}> (0..<{$max-1}>) }}}

    keyword for (ParenthesesList $list, '->', CommaList $parameters, Block $code_block)
                :desc(enhanced for loop)
    {{{
        {
            state $__acc__ = [];
            foreach my $__nary__  <{ $list =~ s{\)\Z}{,\\\$__acc__)}r }>
            {
                if (!ref($__nary__) || $__nary__ != \$__acc__) {
                    push @{$__acc__}, $__nary__;
                    next if @{$__acc__} <= <{ $parameters =~ tr/,// }>;
                }
                next if !@{$__acc__};
                my ( <{"$parameters"}> ) = @{$__acc__};
                @{$__acc__} = ();

                <{substr $code_block, 1, -1}>
            }
        }
    }}}


    # Perl 6 infinite loop...
    keyword loop (Block $loop_block)  {{{
        foreach (;;) <{$loop_block}>
    }}}


    # Perl 6 while loop...
    keyword while (List $condition, Block $loop_block)  {{{
        foreach (;<{$condition}>;) <{$loop_block}>
    }}}

    keyword while (List $condition, '->', ScalarVar $parameter, Block $loop_block)  {{{
        foreach (;my <{$parameter}> = <{$condition}>;) <{$loop_block}>
    }}}


    # Perl 6 repeat...while and variants...

    keyword repeat ('while', List $while_condition, Block $code_block) :desc(repeat loop)  {{{
        foreach(;;) <{substr($code_block,0,-2)}>; last if !(<{$while_condition}>); }
    }}}

    keyword repeat ('until', List $until_condition, Block $code_block) {{{
        foreach(;;) <{substr($code_block,0,-2)}>; last if <{$until_condition}>; }
    }}}

    keyword repeat (Block $code_block,
                    /while|until/ $while_or_until,
                    Expr $condition) {
        my $not = $while_or_until eq 'while' ? q{!} : q{};
        qq{ foreach (;;) { do $code_block; last if $not ($condition); } };
    }


    # Special Perl 6 phasers within loops...

    keytype Etc is / (?: (?&PerlOWS) (?&PerlStatement) )* (?&PerlOWS) \} /x;

    keyword FIRST (Block $code_block) :then(Etc $rest_of_block) :desc(FIRST block) {
        state $FIRST_ID = 'FIRST000000'; $FIRST_ID++;
        qq{
            if (!(our \$$FIRST_ID)++) $code_block
            $rest_of_block;
            {our \$$FIRST_ID = 0}
        };
    }

    keyword NEXT (Block $code_block) :then(Etc $rest_of_block) :desc(NEXT block) {
        state $NEXT_ID = 'NEXT000000'; $NEXT_ID++;
        chop $rest_of_block;
        qq{
            my \$$NEXT_ID = sub $code_block;
            $rest_of_block;
            \$$NEXT_ID->();
            \}
        };
    }

    keyword LAST (Block $code_block) :then(Etc $rest_of_block) :desc(LAST block) {
        state $LAST_ID = 'LAST000000'; $LAST_ID++;
        qq{
            our \$$LAST_ID = sub $code_block;
            $rest_of_block;
            {our \$$LAST_ID->();}
        };
    }

    # try and CATCH...

    keytype CatchParam is / \( (?&PerlOWS) (?&PerlVariableScalar) (?&PerlOWS) \) /x;

    keyword CATCH (CatchParam $param = '($P6C____EXCEPTION)', Block $block) :desc(CATCH phaser) {{{
        BEGIN { eval'$P6C____CATCH=$P6C____CATCH;1' // die q{Can't specify CATCH block outside a try};              }
        BEGIN { die q{Can't specify two CATCH blocks inside a single try} if defined $P6C____CATCH;          }
        BEGIN { $P6C____CATCH = sub { use experimentals; my <{$param}> = @_; given (<{$param}>) <{$block}> } }
    }}}

    keyword try (Block $block) {{{
        { my $P6C____CATCH; eval { <{$block}> 1 } // do{ my $error = $@; $P6C____CATCH && $P6C____CATCH->($error) }; }
    }}}
}

1; # Magic true value required at end of module
__END__