X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FNary.pm;h=de42e73576a67eba931eca0956f58f4a9ccc08d5;hb=790ba71f0305951a6d7bb04ca02a1dad7563f439;hp=4b87e45bc779c0fd4a9c9a3e110b2816c95b8a1b;hpb=19271bbd36d8b5346d323f6e47038b9abff33a91;p=perl%2Fmodules%2FSub-Nary.git diff --git a/lib/Sub/Nary.pm b/lib/Sub/Nary.pm index 4b87e45..de42e73 100644 --- a/lib/Sub/Nary.pm +++ b/lib/Sub/Nary.pm @@ -1,13 +1,13 @@ package Sub::Nary; -use 5.008001; +use 5.008_001; use strict; use warnings; -use Carp qw/croak/; +use Carp qw; -use B qw/class ppname svref_2object OPf_KIDS/; +use B qw; =head1 NAME @@ -33,7 +33,8 @@ BEGIN { =head1 DESCRIPTION -This module uses the L framework to walk into subroutines and try to guess how many scalars are likely to be returned in list context. It's not always possible to give a definitive answer to this question at compile time, so the results are given in terms of "probability of return" (to be understood in a sense described below). +This module uses the L framework to walk into subroutines and try to guess how many scalars are likely to be returned in list context. +It's not always possible to give a definitive answer to this question at compile time, so the results are given in terms of "probability of return" (to be understood in a sense described below). =head1 METHODS @@ -41,21 +42,27 @@ This module uses the L framework to walk into subroutines and try to guess ho my $sn = Sub::Nary->new; -The usual constructor. Currently takes no argument. +The usual constructor. +Currently takes no argument. =head2 C my $res = $sn->nary($coderef); -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 +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 } -that is, we should get C<1> scalar C<1> time over C<5> and so on. The sum of all values is C<1>. The returned result, and all the results obtained from intermediate subs, are cached into the object. +that is, we should get C<1> scalar C<1> time over C<5> and so on. +The sum of all values is C<1>. +The returned result, and all the results obtained from intermediate subs, are cached into the object. =head2 C -Flushes the L object cache. Returns the object itself. +Flushes the L object cache. +Returns the object itself. =head1 PROBABILITY OF RETURN @@ -113,7 +120,8 @@ never returns C<1> argument but returns C<2> with probability C<1/2 * 1/2 = 1/4> If a core function may return different numbers of scalars, each kind is considered equally possible. -For example, C 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 returns C<13> elements on success and C<0> on error. +The according probability will then be C<< { 0 => 0.5, 13 => 0.5 } >>. =item * @@ -203,12 +211,12 @@ sub power { my %ops; $ops{$_} = 1 for scalops; -$ops{$_} = 0 for qw/stub nextstate pushmark iter unstack/; -$ops{$_} = 1 for qw/padsv/; -$ops{$_} = 'list' for qw/padav/; -$ops{$_} = 'list' for qw/padhv rv2hv/; -$ops{$_} = 'list' for qw/padany/; -$ops{$_} = 'list' for qw/match entereval readline/; +$ops{$_} = 0 for qw; +$ops{$_} = 1 for qw; +$ops{$_} = 'list' for qw; +$ops{$_} = 'list' for qw; +$ops{$_} = 'list' for qw; +$ops{$_} = 'list' for qw; $ops{each} = { 0 => 0.5, 2 => 0.5 }; $ops{stat} = { 0 => 0.5, 13 => 0.5 }; @@ -217,12 +225,12 @@ $ops{caller} = sub { my @a = caller 0; scalar @a }->(); $ops{localtime} = do { my @a = localtime; scalar @a }; $ops{gmtime} = do { my @a = gmtime; scalar @a }; -$ops{$_} = { 0 => 0.5, 10 => 0.5 } for map "gpw$_", qw/nam uid ent/; -$ops{$_} = { 0 => 0.5, 4 => 0.5 } for map "ggr$_", qw/nam gid ent/; -$ops{$_} = 'list' for qw/ghbyname ghbyaddr ghostent/; -$ops{$_} = { 0 => 0.5, 4 => 0.5 } for qw/gnbyname gnbyaddr gnetent/; -$ops{$_} = { 0 => 0.5, 3 => 0.5 } for qw/gpbyname gpbynumber gprotoent/; -$ops{$_} = { 0 => 0.5, 4 => 0.5 } for qw/gsbyname gsbyport gservent/; +$ops{$_} = { 0 => 0.5, 10 => 0.5 } for map "gpw$_", qw; +$ops{$_} = { 0 => 0.5, 4 => 0.5 } for map "ggr$_", qw; +$ops{$_} = 'list' for qw; +$ops{$_} = { 0 => 0.5, 4 => 0.5 } for qw; +$ops{$_} = { 0 => 0.5, 3 => 0.5 } for qw; +$ops{$_} = { 0 => 0.5, 4 => 0.5 } for qw; sub enter { my ($self, $cv) = @_; @@ -378,8 +386,8 @@ sub pp_entersub { $next = $next->sibling; } $n = name($op) - } while ($op->flags & OPf_KIDS and { map { $_ => 1 } qw/null leave/ }->{$n}); - return 'list', undef unless { map { $_ => 1 } qw/gv refgen/ }->{$n}; + } while ($op->flags & OPf_KIDS and { map { $_ => 1 } qw }->{$n}); + return 'list', undef unless { map { $_ => 1 } qw }->{$n}; local $self->{sub} = 1; my ($rc, $lc) = $self->inspect($op); return $r, scale $c, $lc; @@ -604,7 +612,10 @@ C isn't specialized when encountered in the optree. L 5.8.1. -L (standard since perl 5), L (since perl 5.005) and L (since perl 5.006). +A C compiler. +This module may happen to build with a C++ compiler as well, but don't rely on it, as no guarantee is made in this regard. + +L (standard since perl 5), L (since perl 5.005) and L (since perl 5.6.0). =head1 AUTHOR @@ -614,7 +625,8 @@ You can contact me by mail or on C (vincent). =head1 BUGS -Please report any bugs or feature requests to C, or through the web interface at L. 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, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT