- my $i = 0;
- while ($proto =~ /(\\?)(\[[^\]]+\]|[^\];])/g) {
- my $p = $2;
- if ($1) {
- my $r = _check_ref $_[$i], $p;
- $call .= $sigils{$r} . '{$_[' . $i . ']},';
- } elsif ($p =~ /[\@\%]/) {
- $call .= '@_[' . $i . '..' . (@_ - 1) . ']';
- last;
- } elsif ($p =~ /\&/) {
- push @cr, $_[$i];
- $call .= 'sub{&{$cr[' . $#cr . ']}},';
- } elsif ($p eq '_' && $i >= @_) {
- $call .= '$_,';
- } else {
- $call .= '$_[' . $i . '],';
- }
- ++$i;
+ $call = _wrap $name, $proto, 0, '', \@coderefs, \%opts;
+ } else {
+ $call = _wrap $name, '', 0, '@_';
+ }
+
+ if (@coderefs) {
+ my $decls = @coderefs > 1 ? 'my @c = @_[' . join(', ', @coderefs) . ']; '
+ : 'my @c = ($_[' . $coderefs[0] . ']); ';
+ $call = $decls . $call;
+ }
+
+ $call = "{ $call }";
+ $call = "sub $call" if $opts{sub};
+
+ if ($opts{compile}) {
+ my $err;
+ {
+ local $@;
+ $call = eval $call;
+ $err = $@;
+ }
+ croak _clean_msg $err if $err;
+ }
+
+ return $call;
+}
+
+=head2 C<recall>
+
+ my @res = recall($name, @args);
+ my @res = recall({ $name => $proto }, @args);
+
+Calls the function C<$name> with the prototyped argument list C<@args>.
+That is, C<@args> should be what C<@_> is when you call a subroutine with C<$name> as prototype.
+You can still force the prototype by passing C<< { $name => $proto } >> as the first argument.
+
+ my $a = [ ];
+ recall { 'CORE::push' => '\@$' }, $a, 1, 2, 3; # $a just contains 1
+
+It's implemented in terms of L</wrap>, and hence calls C<eval> at each run.
+If you plan to recall several times, consider using L</wrap> instead.
+
+=cut
+
+sub recall;
+
+BEGIN {
+ my $safe_wrap = sub {
+ my $name = shift;
+
+ my ($wrap, $err);
+ {
+ local $@;
+ $wrap = eval { wrap $name };
+ $err = $@;
+ }
+
+ $wrap, $err;
+ };
+
+ if ("$]" == 5.008) {
+ # goto tends to crash a lot on perl 5.8.0
+ *recall = sub {
+ my ($wrap, $err) = $safe_wrap->(shift);
+ croak _clean_msg $err if $err;
+ $wrap->(@_)