与原型相关联的注意事项,尽管如此,可以将两个下面设计的子设备存在于同一个包中,即提供类似排序的可选块参数吗?
sub myprint { for (@_) { print "$_\n"; } } sub myprint (&@) { my $block = shift; for (@_) { print $block->() . "\n"; } }
意图是提供类似于排序的调用约定,例如允许执行:
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"; } }
……但是& @ prototype提供了语法糖;删除要求:
my @y = ( {a=>'foo'},{a=>'baz'} ); print_list sub { $_->{a} },@y; # note the extra sub and comma
(我已经尝试了;& @,无济于事 – 它仍然会将main :: myprint的arg 1类型生成为block或sub {}(非私有数组).)
解决方法
是.
不幸的是,这有点痛苦.您需要使用Perl 5.14中引入的关键字API.这意味着您需要在C中实现它(以及它的自定义解析)并使用XS将其链接到Perl.
幸运的是,DOY为Perl关键字API编写了一个很好的包装器,允许您在纯Perl中实现关键字.没有C,没有XS!它被称为Parse::Keyword.
不幸的是,这有很多错误处理封闭的变量.
无论如何,这是一个例子:
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","c";
a b c [a] [b] [c]