Perl:后期Coderef参数的语法糖？

Question

使用子原型,我们可以定义我们自己的看起来像map或grep的subs.也就是说,第一个coderef参数的语法比普通的匿名子语言短.例如:

sub thunked (&) { $_[0] }

my $val = thunked { 2 * 4 };

这里工作得很好,因为第一个参数是coderef.但是对于后面的参数,它很简单,不能正确解析.

我制作了一个with子程序,旨在使GTK2代码更清晰.它看起来像这样(未经测试,因为它是假设的代码):

use 5.012;
use warnings;

use Gtk2 '-init';    

sub with ($&) {
    local $_ = $_[0];
    $_[1]->();
    $_;
}

for (Gtk2::Window->new('toplevel')) {
    $_->set_title('Test Application');
    $_->add(with Gtk2::VBox->new {
        my $box = $_;
        $box->add(Gtk2::Button->new("Button $_")) for (1..4);
    });
    $_->show_all;
}
Gtk2->main;

它不起作用,因为with需要将块作为第一个参数才能使用漂亮的语法.有什么方法可以把它拉下来吗？

Answer 1

Devel :: Declare模块包含以相对安全的方式扩展Perl语法的工具.

使用Devel :: Declare,您将在with令牌上创建一个钩子,当它到达该词时将停止解析器.从那里,你可以控制解析器,你可以提前读取,直到你到达一个{符号.此时,您已经拥有了需要使用的内容,因此您将其重写为有效的Perl,并将其传递回解析器.

在文件中With.pm:

package With;
use warnings;
use strict;
use Devel::Declare;

sub import {
    my $caller = caller;
    Devel::Declare->setup_for (
        $caller => {with => {const => \&parser}}
    );
    no strict 'refs';
    *{$caller.'::with'} = sub ($&) {
        $_[1]() for $_[0];
        $_[0]
    }
}

our $prefix = '';
sub get {substr Devel::Declare::get_linestr, length $prefix}
sub set {       Devel::Declare::set_linestr $prefix . $_[0]}

sub parser {
    local $prefix = substr get, 0, length($_[0]) + $_[1];
    my $with = strip_with();
    strip_space();
    set "scalar($with), sub " . get;
}

sub strip_space {
    my $skip = Devel::Declare::toke_skipspace length $prefix;
    set substr get, $skip;
}

sub strip_with {
    strip_space;
    my $with;
    until (get =~ /^\{/) {
        (my $line = get) =~ s/^([^{]+)//;
        $with .= $1;
        set $line;
        strip_space;
    }
    $with =~ s/\s+/ /g;
    $with
}

并使用它:

use With;

sub Window::add {say "window add: ", $_[1]->str}
sub Window::new {bless [] => 'Window'}
sub Box::new    {bless [] => 'Box'}
sub Box::add    {push @{$_[0]}, @_[1..$#_]}
sub Box::str    {"Box(@{$_[0]})"}
sub Button::new {"Button($_[1])"}

with Window->new {
    $_->add(with Box->new {
        for my $num (1 .. 4) {
            $_->add(Button->new($num))
        }
    })
};

哪个印刷品:

window add: Box(Button(1) Button(2) Button(3) Button(4))

一种完全不同的方法是with完全跳过关键字并编写一个例程来生成构造函数子例程:

BEGIN {
    for my $name (qw(VBox)) { # and any others you want
        no strict 'refs';
        *$name = sub (&@) {
            use strict;
            my $code = shift;
            my $with = "Gtk2::$name"->new(@_);
            $code->() for $with;
            $with
        }
    }
}

然后你的代码看起来像

for (Gtk2::Window->new('toplevel')) {
    $_->set_title('Test Application');
    $_->add(VBox {
        my $box = $_;
        $box->add(Gtk2::Button->new("Button $_")) for (1..4);
    });
    $_->show_all;
}

Answer 2

你可以处理它的一种方法是添加一个相当无用的关键字:

sub perform(&) { $_[0] }

with GTK2::VBox->new, perform { ... }

哪里perform真的只是一个更加可靠的选择sub.

另一种方法是编写一个Devel :: Declare过滤器或一个Syntax :: Keyword ::插件来实现你的with,只要你有办法告诉你何时完成解析with参数并准备开始解析块 - 平衡括号会做(所以一个开口的大括号,但然后哈希成为一个问题).然后你可以支持类似的东西

with (GTK2::VBox->new) { ... }

并让过滤器将其重写为类似的东西

do {
    local $_ = GTK2::VBox->new;
    do {
        ...;
    };
    $_;
}

其中,如果一切正常,并没有真正创建一个子,因此不会干扰的优势@_,return以及一些其他的东西.do我认为这两层对于能够在适当的位置安装EndOfScope挂钩是必要的.

这样做的明显缺点是它很棘手,它很毛茸茸,而且它是一个源过滤器(即使它是一个温顺的过滤器),这意味着如果你想让任何使用它的代码可以调试,你必须解决问题.