Sottoroutine che prendono un parametro di blocco facoltativo

Question

Gli avvertimenti associati ai prototipi accettati e nonostante, possono esistere i due sotto-sotto-sotto-derivati ​​all'interno dello stesso pacchetto, vale a dire fornire un parametro di blocco opzionale come sort?

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

L'intento è di fornire una convenzione di chiamata simile come sort, ad esempio per consentire l'esecuzione di:

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

# foo 
# bar 
# baz 

... e:

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

# foo 
# bar 
# baz 

ottengo ridefinire e/o avvisi prototipo mancata corrispondenza se provo (che è ragionevole).

Suppongo che posso fare:

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

... ma il prototipo &@ fornisce lo zucchero sintattico; rimozione richiede:

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

(ho provato ;&@, senza alcun risultato - produce ancora Type of arg 1 to main::myprint must be block or sub {} (not private array).)

Answer 1

Sì.

Sfortunatamente è un po 'un dolore. È necessario utilizzare la parola chiave API introdotta in Perl 5.14. Ciò significa che è necessario implementarlo (e l'analisi personalizzata per esso) in C e collegarlo a Perl con XS.

Fortunatamente DOY ha scritto un ottimo wrapper per l'API della parola chiave Perl, che consente di implementare parole chiave in puro Perl. No C, no XS! Si chiama Parse::Keyword.

Sfortunatamente questo ha grossi problemi relativi alle variabili chiuse.

Fortunatamente possono essere lavorati utilizzando PadWalker.

Comunque, ecco un esempio:

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"; 

Questo genera il seguente output:

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

Answer 2

Non è possibile dichiarare una subroutine con lo stesso comportamento sintattico come sort. Per controllare, prova

prototype('CORE::sort') 

che restituisce undef.