Можете ли вы взять ссылку встроенной функции в Perl?

Ответ 1

Нет, вы не можете. В чем основная проблема, которую вы пытаетесь решить? Может быть какой-то способ сделать то, что есть.

Повторите добавленную часть вопроса "В случае необходимости ваш ответ может включать XS, но я бы предпочел не делать этого". вызывать встроенные функции из XS действительно сложно, так как встроенные функции настроены так, чтобы считать, что они выполняются как часть скомпилированного опциона и имеют некоторые глобальные переменные. Обычно гораздо проще назвать некоторую базовую функцию, которую использует встроенный пользователь, хотя не всегда есть такая функция, поэтому вы видите такие вещи, как:

buffer = sv_2mortal(newSVpvf("(caller(%d))[3]", (int) frame));
caller = eval_pv(SvPV_nolen(buffer), 1);

(выполнение строки eval из XS вместо того, чтобы проходить через обручи, необходимые для прямого вызова pp_caller).

Ответ 2

Я играл с универсальными решениями для этого и придумал следующий грязный взлом с использованием eval. Он в основном использует прототип, чтобы раздвинуть @_, а затем вызвать встроенный. Это было только слегка проверено и использует строчную форму eval, поэтому некоторые могут сказать, что ее уже сломал: -)

use 5.10.0;
use strict;
use warnings;

sub builtin {
    my ($sub, $my, $id) = ($_[0], '');
    my $proto = prototype $sub         //
                prototype "CORE::$sub" //
                $_[1]                  //
                ($sub =~ /map|grep/ ? '&@' : '@;_');
    for ($proto =~ /(\\?.)/g) { $id++;
        if (/(?|(\$|&)|.(.))/) {
            $my  .= "my \$_$id = shift;";
            $sub .= " $1\$_$id,";
        } elsif (/([@%])/) {
            $my  .= "my $1_$id = splice \@_, 0, \@_;";
            $sub .= " $1_$id,";
        } elsif (/_/) {
            $my  .= "my \$_$id = \@_ ? shift : \$_;";
            $sub .= " \$_$id,"
        }
    }
    eval "sub ($proto) {$my $sub}"
        or die "prototype ($proto) failed for '$_[0]', ".
               "try passing a prototype string as \$_[1]"
}

my $shift = builtin 'shift';
my @a = 1..10;
say $shift->(\@a);
say "@a";

my $uc = builtin 'uc';
local $_ = 'goodbye';
say $uc->('hello '), &$uc;

my $time = builtin 'time';
say &$time;

my $map = builtin 'map';
my $reverse = builtin 'reverse';
say $map->(sub{"$_, "}, $reverse->(@a));

my %h = (a=>1, b=>2);
my $keys = builtin 'keys';
say $keys->(\%h);

# which prints
# 1
# 2 3 4 5 6 7 8 9 10
# HELLO GOODBYE
# 1256088298
# 10, 9, 8, 7, 6, 5, 4, 3, 2, 
# ab

Пересмотрено ниже и реорганизовано.

Ответ 3

Это можно сделать, если вы сначала исправили внутренний метод (который даст вам код вашего патча):

use strict;
use warnings;

BEGIN {
    *CORE::GLOBAL::die = sub { warn "patched die: '$_[0]'"; exit 3 };
}

print "ref to patched die: " . \&CORE::GLOBAL::die . "\n";
die "ack, I am slain";

дает результат:

ref to patched die: CODE(0x1801060)
patched die: 'ack, I am slain' at patch.pl line 5.

BTW: Я был бы признателен, если кто-нибудь сможет объяснить, почему переопределение должно выполняться как *CORE::GLOBAL::die, а не *CORE::die. Я не могу найти никаких ссылок на это. Кроме того, почему необходимо выполнить переопределение в блоке BEGIN? Вызов die() выполняется во время выполнения, поэтому почему переопределение не может быть выполнено во время выполнения раньше?

Ответ 4

Вы можете переносить смену на что-то, что вы можете ссылаться, но вы должны использовать прототип, чтобы использовать его, поскольку смена является специальной.

sub my_shift (\@) { my $ll = shift; return shift @$ll }

Проблема в том, что прототипная система не может волшебным образом выяснить, что, когда она вызывает некоторый случайный реф-к-юг в скаляре, ему нужно взять ссылку перед вызовом подпрограммы.

my @list = (1,2,3,4);

sub my_shift (\@) { my $ll = shift; return shift @$ll }

my $a = shift @list;
my $my_shift_ref = \&my_shift;
my $b = (&{$my_shift_ref}  (\@list) ); # see below

print "a=$a, b=$b\n";

for (my $i = 0; $i <= $#list; ++$i) { print "\$list[$i] = ",$list[$i],"\n"; }

Если это называется просто @list, perl barfs, потому что он не может автоматически ссылаться на способ shift.

См. также: [http://www.perl.com/language/misc/fmproto.html][Tom статья Кристенсена].

Конечно, для встроенных функций, которые не являются особыми, как shift, вы всегда можете делать

sub my_fork { return fork; }

а затем &my_fork все, что вы хотите.

Ответ 5

Как я понимаю, вы хотите иметь coderef, который будет вызываться на некоторых данных, и это может указывать на некоторые ваши функции или встроенные функции.

Если я прав, просто поставьте встроенное в закрытие:

#!/usr/bin/perl -w
use strict;

my $coderef = \&test;
$coderef->( "Test %u\n", 1 );

$coderef = sub { printf @_ };
$coderef->( "Test %u\n", 2 );

exit;

sub test {
    print join(' ', map { "[$_]" } @_) . "\n";
}

Выполнение этого со сдвигом также возможно, но помните, что сдвиг без явного массива для работы, работает на разных массивах на основе того, где он был вызван.

Ответ 6

Если вы хотите увидеть, что нужно, чтобы подделать его в коде качества продукции, посмотрите код autodie. Мясо находится в Fatal. Помогает, если вы сумасшедший пиратский джедай австралийский.

Ответ 7

Единственный способ заставить его работать - сделать ссылку на sub{shift}.

perl -e '@a=(1..3); $f=sub{shift}; print($f->(@a), "\n");'

Это функционально эквивалентно:

perl -e '@a=(1..3); print(shift(@a), "\n");'

Что может быть просто perl -e 'print 1, "\n"', но тогда мы не будем говорить о встроенной версии.

Для вашей информации я удивлен тем, что нельзя ссылаться на встроенный, и теперь, когда мне было ясно, я не могу не думать об этом как о недостатке Perl.

Update Эрик правильно указывает, что $f=sub{shift}; $f->(@a) оставляет @a неизменным. Это должно быть больше похоже:

perl -e '@a=(1..3); $f=sub{shift @{+shift}}; print($f->(\@a), "\n");

Спасибо Эрику.