带有可选块参数的子例程

金博姆奇

与原型相关的警告已被接受,尽管如此,以下两个人为伪造的subs是否可以存在于同一程序包中,即像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)。)

托比墨

是。

不幸的是,这有点痛苦。您需要使用Perl 5.14中引入的关键字API。这意味着您需要在C中实现它(以及对其进行自定义解析),然后使用XS将其链接到Perl。

幸运的是,DOY为Perl关键字API写了一个很棒的包装,使您可以在纯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]

本文收集自互联网,转载请注明来源。

如有侵权,请联系[email protected] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

如何为可选子例程参数指定默认值?

来自分类Dev

为什么带有假定形状参数的子例程不能具有内部函数?

来自分类Dev

带有可选参数的 RewriteRule

来自分类Dev

我可以将带有参数的子例程存储在哈希中吗?

来自分类Dev

工厂模式-带有可选参数

来自分类Dev

带有可选参数的DSL语法

来自分类Dev

带有可选查询参数的Sinatra

来自分类Dev

带有HttpResponseRedirect的Django可选视图参数

来自分类Dev

带有可选闭包的参数

来自分类Dev

Suave中带有可选参数的路线

来自分类Dev

如何创建带有可选参数的过程?

来自分类Dev

带有可选参数的嵌套路由

来自分类Dev

带有可选参数的Varargs函数

来自分类Dev

单击带有可选参数的工具

来自分类Dev

带有可选Y参数swift的LineChart

来自分类Dev

编写带有可选参数的函数

来自分类Dev

带有几个可选参数的Symfony路由

来自分类Dev

工厂模式-带有可选参数

来自分类Dev

带有可选参数的 R 包装函数

来自分类Dev

带有可选参数的构造函数

来自分类Dev

带有可选参数的继承链

来自分类Dev

如何获取带有子例程的开始和结束行号的perl子例程列表?

来自分类Dev

UniData列出所有可用的子例程/所有参数

来自分类Dev

UniData列出所有可用的子例程/所有参数

来自分类Dev

从多个线程调用带有OPEN语句的子例程

来自分类Dev

带有子例程的线程不返回任何内容

来自分类Dev

带有子模块的Fortran子例程重载

来自分类Dev

传递作为可选参数的优雅方法,以使子例程像被忽略一样工作?

来自分类Dev

传递作为可选参数的优雅方法,以使子例程像被忽略一样工作?