Подпрограммы, которые принимают необязательный параметр блока

Question

Предостережения, связанные с прототипами, принятыми и не считающимися c, могут ли две поддублированные подписи существовать внутри одного и того же пакета, то есть для предоставления необязательного параметра блока, такого как sort?

sub myprint { 
    for (@_) { 
     print "$_\n"; 
    } 
} 
sub myprint (&@) { 
    my $block = shift; 
    for (@_) { 
     print $block->() . "\n"; 
    } 
} 

Целью является обеспечить аналогичное соглашение о вызовах, как, например sort разрешить выполнение:

my @x = qw(foo bar baz); 
print_list @x; 

# foo 
# bar 
# baz 

... и:

my @y = ({a=>'foo'}, {a=>'bar'}, {a=>'baz'}); 
print_list { $_->{a} } @y; 

# foo 
# bar 
# baz 

я переопределить и/или предупреждения несоответствия прототипа, если я стараюсь (что разумно).

Я полагаю, что я могу сделать:

sub myprint { 
    my $block = undef; 
    $block = shift if @_ && ref($_[0]) eq 'CODE'; 
    for (@_) { 
     print (defined($block) ? $block->() : $_) . "\n"; 
    } 
} 

... но &@ прототип обеспечивает синтаксический сахар; удаление требует:

my @y = ({a=>'foo'}, {a=>'bar'}, {a=>'baz'}); 
print_list sub { $_->{a} }, @y;     # note the extra sub and comma 

(я пытался ;&@, но безрезультатно - она ​​по-прежнему дает Type of arg 1 to main::myprint must be block or sub {} (not private array).)

Answer 1

Да.

К сожалению, это немного боль. Вам нужно использовать ключевое слово API, представленное в Perl 5.14. Это означает, что вам нужно реализовать его (и настраиваемый синтаксический анализ для него) в C и связать его с Perl с XS.

К счастью, DOY написал отличную оболочку для API-интерфейса Perl, позволяя реализовать ключевые слова в чистом Perl. Нет C, нет XS! Это называется Parse::Keyword.

К сожалению, у этого есть основные ошибки, связанные с закрытыми переменными.

К счастью, их можно обойти, используя PadWalker.

Во всяком случае, вот пример:

use v5.14; 

BEGIN { 
    package My::Print; 
    use Exporter::Shiny qw(myprint); 
    use Parse::Keyword { myprint => \&_parse_myprint }; 
    use PadWalker; 

    # Here's the actual implementation of the myprint function. 
    # When the caller includes a block, this will be the first 
    # parameter. When they don't, we'll pass an explicit undef 
    # in as the first parameter, to make sure it's nice and 
    # unambiguous. This helps us distinguish between these two 
    # cases: 
    # 
    # myprint { BLOCK } @list_of_coderefs; 
    # myprint @list_of_coderefs; 
    # 
    sub myprint { 
    my $block = shift; 
    say for defined($block) ? map($block->($_), @_) : @_; 
    } 

    # This is a function to handle custom parsing for 
    # myprint. 
    # 
    sub _parse_myprint { 

    # There might be whitespace after the myprint 
    # keyword, so read and discard that. 
    # 
    lex_read_space; 

    # This variable will be undef if there is no 
    # block, but we'll put a coderef in it if there 
    # is a block. 
    # 
    my $block = undef; 

    # If the next character is an opening brace... 
    # 
    if (lex_peek eq '{') { 

     # ... then ask Parse::Keyword to parse a block. 
     # (This includes parsing the opening and closing 
     # braces.) parse_block will return a coderef, 
     # which we will need to fix up (see later). 
     # 
     $block = _fixup(parse_block); 

     # The closing brace may be followed by whitespace. 
     # 
     lex_read_space; 
    } 

    # After the optional block, there will be a list 
    # of things. Parse that. parse_listexpr returns 
    # a coderef, which when called will return the 
    # actual list. Again, this needs a fix up. 
    # 
    my $listexpr = _fixup(parse_listexpr); 

    # This is the stuff that we need to return for 
    # Parse::Keyword. 
    # 
    return (

     # All of the above stuff happens at compile-time! 
     # The following coderef gets called at run-time, 
     # and gets called in list context. Whatever stuff 
     # it returns will then get passed to the real 
     # `myprint` function as @_. 
     # 
     sub { $block, $listexpr->() }, 

     # This false value is a signal to Parse::Keyword 
     # to say that myprint is an expression, not a 
     # full statement. If it was a full statement, then 
     # it wouldn't need a semicolon at the end. (Just 
     # like you don't need a semicolon after a `foreach` 
     # block.) 
     # 
     !!0, 
    ); 
    } 

    # This is a workaround for a big bug in Parse::Keyword! 
    # The coderefs it returns get bound to lexical 
    # variables at compile-time. However, we need access 
    # to the variables at run-time. 
    # 
    sub _fixup { 

    # This is the coderef generated by Parse::Keyword. 
    # 
    my $coderef = shift; 

    # Find out what variables it closed over. If it didn't 
    # close over any variables, then it's fine as it is, 
    # and we don't need to fix it. 
    # 
    my $closed_over = PadWalker::closed_over($coderef); 
    return $coderef unless keys %$closed_over; 

    # Otherwise we need to return a new coderef that 
    # grabs its caller's lexical variables at run-time, 
    # pumps them into the original coderef, and then 
    # calls the original coderef. 
    # 
    return sub { 
     my $caller_pad = PadWalker::peek_my(2); 
     my %vars = map +($_ => $caller_pad->{$_}), keys %$closed_over; 
     PadWalker::set_closed_over($coderef, \%vars); 
     goto $coderef; 
    }; 
    } 
}; 

use My::Print qw(myprint); 

my $start = "["; 
my $end = "]"; 

myprint "a", "b", "c"; 

myprint { $start . $_ . $end } "a", "b", "c"; 

Это генерирует следующий вывод:

a 
b 
c 
[a] 
[b] 
[c] 

Answer 2

Вы не можете объявить подпрограмму с тем же синтаксическим поведением как sort. Чтобы проверить, попробуйте

prototype('CORE::sort') 

который возвращает undef.