-Takes a code reference to a named or anonymous subroutine, and returns a hash reference whose keys are the possible numbers of returning scalars, and the corresponding values the "probability" to get them. The special key C<'list'> is used to denote a possibly infinite number of returned arguments. The return value hence would look at
+Takes a reference to a named or anonymous subroutine, and returns a hash reference whose keys are the possible numbers of returning scalars, and the corresponding values the "probability" to get them. The special key C<'list'> is used to denote a possibly infinite number of returned arguments. The return value hence would look at
{ 1 => 0.2, 2 => 0.4, 4 => 0.3, list => 0.1 }
{ 1 => 0.2, 2 => 0.4, 4 => 0.3, list => 0.1 }
it is considered to return C<3> scalars with probability C<1/2>, C<2> with probability C<1/2 * 1/2 = 1/4> and C<1> (when the two tests fail, the last computed value is returned, which here is C<< $x > 0.9 >> evaluated in the scalar context of the test) with remaining probability C<1/4>.
it is considered to return C<3> scalars with probability C<1/2>, C<2> with probability C<1/2 * 1/2 = 1/4> and C<1> (when the two tests fail, the last computed value is returned, which here is C<< $x > 0.9 >> evaluated in the scalar context of the test) with remaining probability C<1/4>.
For example, C<stat> returns C<13> elements on success and C<0> on error. The according probability will then be C<< { 0 => 0.5, 13 => 0.5 } >>.
For example, C<stat> returns C<13> elements on success and C<0> on error. The according probability will then be C<< { 0 => 0.5, 13 => 0.5 } >>.
return add($self->inspect_kids($op)), undef if $n eq 'return';
my $meth = $self->can('pp_' . $n);
return add($self->inspect_kids($op)), undef if $n eq 'return';
my $meth = $self->can('pp_' . $n);
my $op = $op->first;
my ($r1, $l1) = $self->inspect($op);
return $r1, $l1 if defined $r1 and zero $l1;
my $op = $op->first;
my ($r1, $l1) = $self->inspect($op);
return $r1, $l1 if defined $r1 and zero $l1;
- return undef, 0 if null $op;
- if (name($op) eq 'pushmark') {
- $op = $op->sibling;
- return undef, 0 if null $op;
- }
+ # First must be a pushmark
+ $op = $op->sibling;
+ # Next must be non null - at worse it's the rv2cv
- $r = add $r, scale $c, $rc if defined $rc;
- if (zero $lc) {
- $c = 1 - count $r;
- return $r, $c ? { 0 => $c } : undef
- }
+ return $rc, $lc if defined $rc and not defined $lc;
+ $r = add $r, scale $c, $rc;
- my ($r, $l) = $self->inspect($op);
- if (name($op) ne 'const') {
- my $c = 1 - count $r;
- $l = $c ? { list => $c } : 0;
+ if (name($op) eq 'gv') {
+ return undef, { list => 1 };
my ($r1, $l1) = $self->inspect($op);
return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
and not zero $l2;
my ($r1, $l1) = $self->inspect($op);
return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
and not zero $l2;
my ($r1, $l1) = $self->inspect($op);
return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
and not zero $l2;
my ($r1, $l1) = $self->inspect($op);
return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
and not zero $l2;
-Please report any bugs or feature requests to C<bug-b-nary at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sub-Nary>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+Please report any bugs or feature requests to C<bug-sub-nary at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sub-Nary>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.