| Filename | /Users/ap13/perl5/lib/perl5/darwin-2level/List/MoreUtils.pm |
| Statements | Executed 27 statements in 788µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 66 | 3 | 1 | 184µs | 184µs | List::MoreUtils::firstidx (xsub) |
| 1 | 1 | 1 | 132µs | 132µs | List::MoreUtils::bootstrap (xsub) |
| 1 | 1 | 1 | 50µs | 584µs | List::MoreUtils::BEGIN@9 |
| 1 | 1 | 1 | 24µs | 24µs | List::MoreUtils::BEGIN@3 |
| 1 | 1 | 1 | 23µs | 122µs | List::MoreUtils::BEGIN@8 |
| 3 | 1 | 1 | 17µs | 17µs | List::MoreUtils::uniq (xsub) |
| 1 | 1 | 1 | 11µs | 39µs | List::MoreUtils::BEGIN@4 |
| 1 | 1 | 1 | 5µs | 5µs | List::MoreUtils::BEGIN@5 |
| 1 | 1 | 1 | 5µs | 5µs | List::MoreUtils::BEGIN@6 |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package List::MoreUtils; | ||||
| 2 | |||||
| 3 | 2 | 73µs | 1 | 24µs | # spent 24µs within List::MoreUtils::BEGIN@3 which was called:
# once (24µs+0s) by Package::DeprecationManager::BEGIN@10 at line 3 # spent 24µs making 1 call to List::MoreUtils::BEGIN@3 |
| 4 | 2 | 37µs | 2 | 66µs | # spent 39µs (11+28) within List::MoreUtils::BEGIN@4 which was called:
# once (11µs+28µs) by Package::DeprecationManager::BEGIN@10 at line 4 # spent 39µs making 1 call to List::MoreUtils::BEGIN@4
# spent 28µs making 1 call to strict::import |
| 5 | 2 | 32µs | 1 | 5µs | # spent 5µs within List::MoreUtils::BEGIN@5 which was called:
# once (5µs+0s) by Package::DeprecationManager::BEGIN@10 at line 5 # spent 5µs making 1 call to List::MoreUtils::BEGIN@5 |
| 6 | 2 | 46µs | 1 | 5µs | # spent 5µs within List::MoreUtils::BEGIN@6 which was called:
# once (5µs+0s) by Package::DeprecationManager::BEGIN@10 at line 6 # spent 5µs making 1 call to List::MoreUtils::BEGIN@6 |
| 7 | |||||
| 8 | 2 | 176µs | 2 | 222µs | # spent 122µs (23+99) within List::MoreUtils::BEGIN@8 which was called:
# once (23µs+99µs) by Package::DeprecationManager::BEGIN@10 at line 8 # spent 122µs making 1 call to List::MoreUtils::BEGIN@8
# spent 99µs making 1 call to vars::import |
| 9 | # spent 584µs (50+535) within List::MoreUtils::BEGIN@9 which was called:
# once (50µs+535µs) by Package::DeprecationManager::BEGIN@10 at line 40 | ||||
| 10 | 5 | 33µs | $VERSION = '0.33'; | ||
| 11 | # $VERSION = eval $VERSION; | ||||
| 12 | @ISA = qw{ Exporter DynaLoader }; | ||||
| 13 | @EXPORT_OK = qw{ | ||||
| 14 | any all none notall true false | ||||
| 15 | firstidx first_index lastidx last_index | ||||
| 16 | insert_after insert_after_string | ||||
| 17 | apply indexes | ||||
| 18 | after after_incl before before_incl | ||||
| 19 | firstval first_value lastval last_value | ||||
| 20 | each_array each_arrayref | ||||
| 21 | pairwise natatime | ||||
| 22 | mesh zip uniq distinct | ||||
| 23 | minmax part | ||||
| 24 | }; | ||||
| 25 | %EXPORT_TAGS = ( | ||||
| 26 | all => \@EXPORT_OK, | ||||
| 27 | ); | ||||
| 28 | |||||
| 29 | # Load the XS at compile-time so that redefinition warnings will be | ||||
| 30 | # thrown correctly if the XS versions of part or indexes loaded | ||||
| 31 | 3 | 12µs | eval { | ||
| 32 | # PERL_DL_NONLAZY must be false, or any errors in loading will just | ||||
| 33 | # cause the perl code to be tested | ||||
| 34 | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY}; | ||||
| 35 | |||||
| 36 | 1 | 535µs | bootstrap List::MoreUtils $VERSION; # spent 535µs making 1 call to DynaLoader::bootstrap | ||
| 37 | 1; | ||||
| 38 | |||||
| 39 | } unless $ENV{LIST_MOREUTILS_PP}; | ||||
| 40 | 1 | 354µs | 1 | 584µs | } # spent 584µs making 1 call to List::MoreUtils::BEGIN@9 |
| 41 | |||||
| 42 | 1 | 500ns | eval <<'END_PERL' unless defined &any; | ||
| 43 | |||||
| 44 | # Use pure scalar boolean return values for compatibility with XS | ||||
| 45 | use constant YES => ! 0; | ||||
| 46 | use constant NO => ! 1; | ||||
| 47 | |||||
| 48 | sub any (&@) { | ||||
| 49 | my $f = shift; | ||||
| 50 | foreach ( @_ ) { | ||||
| 51 | return YES if $f->(); | ||||
| 52 | } | ||||
| 53 | return NO; | ||||
| 54 | } | ||||
| 55 | |||||
| 56 | sub all (&@) { | ||||
| 57 | my $f = shift; | ||||
| 58 | foreach ( @_ ) { | ||||
| 59 | return NO unless $f->(); | ||||
| 60 | } | ||||
| 61 | return YES; | ||||
| 62 | } | ||||
| 63 | |||||
| 64 | sub none (&@) { | ||||
| 65 | my $f = shift; | ||||
| 66 | foreach ( @_ ) { | ||||
| 67 | return NO if $f->(); | ||||
| 68 | } | ||||
| 69 | return YES; | ||||
| 70 | } | ||||
| 71 | |||||
| 72 | sub notall (&@) { | ||||
| 73 | my $f = shift; | ||||
| 74 | foreach ( @_ ) { | ||||
| 75 | return YES unless $f->(); | ||||
| 76 | } | ||||
| 77 | return NO; | ||||
| 78 | } | ||||
| 79 | |||||
| 80 | sub true (&@) { | ||||
| 81 | my $f = shift; | ||||
| 82 | my $count = 0; | ||||
| 83 | foreach ( @_ ) { | ||||
| 84 | $count++ if $f->(); | ||||
| 85 | } | ||||
| 86 | return $count; | ||||
| 87 | } | ||||
| 88 | |||||
| 89 | sub false (&@) { | ||||
| 90 | my $f = shift; | ||||
| 91 | my $count = 0; | ||||
| 92 | foreach ( @_ ) { | ||||
| 93 | $count++ unless $f->(); | ||||
| 94 | } | ||||
| 95 | return $count; | ||||
| 96 | } | ||||
| 97 | |||||
| 98 | sub firstidx (&@) { | ||||
| 99 | my $f = shift; | ||||
| 100 | foreach my $i ( 0 .. $#_ ) { | ||||
| 101 | local *_ = \$_[$i]; | ||||
| 102 | return $i if $f->(); | ||||
| 103 | } | ||||
| 104 | return -1; | ||||
| 105 | } | ||||
| 106 | |||||
| 107 | sub lastidx (&@) { | ||||
| 108 | my $f = shift; | ||||
| 109 | foreach my $i ( reverse 0 .. $#_ ) { | ||||
| 110 | local *_ = \$_[$i]; | ||||
| 111 | return $i if $f->(); | ||||
| 112 | } | ||||
| 113 | return -1; | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | sub insert_after (&$\@) { | ||||
| 117 | my ($f, $val, $list) = @_; | ||||
| 118 | my $c = -1; | ||||
| 119 | local *_; | ||||
| 120 | foreach my $i ( 0 .. $#$list ) { | ||||
| 121 | $_ = $list->[$i]; | ||||
| 122 | $c = $i, last if $f->(); | ||||
| 123 | } | ||||
| 124 | @$list = ( | ||||
| 125 | @{$list}[ 0 .. $c ], | ||||
| 126 | $val, | ||||
| 127 | @{$list}[ $c + 1 .. $#$list ], | ||||
| 128 | ) and return 1 if $c != -1; | ||||
| 129 | return 0; | ||||
| 130 | } | ||||
| 131 | |||||
| 132 | sub insert_after_string ($$\@) { | ||||
| 133 | my ($string, $val, $list) = @_; | ||||
| 134 | my $c = -1; | ||||
| 135 | foreach my $i ( 0 .. $#$list ) { | ||||
| 136 | local $^W = 0; | ||||
| 137 | $c = $i, last if $string eq $list->[$i]; | ||||
| 138 | } | ||||
| 139 | @$list = ( | ||||
| 140 | @{$list}[ 0 .. $c ], | ||||
| 141 | $val, | ||||
| 142 | @{$list}[ $c + 1 .. $#$list ], | ||||
| 143 | ) and return 1 if $c != -1; | ||||
| 144 | return 0; | ||||
| 145 | } | ||||
| 146 | |||||
| 147 | sub apply (&@) { | ||||
| 148 | my $action = shift; | ||||
| 149 | &$action foreach my @values = @_; | ||||
| 150 | wantarray ? @values : $values[-1]; | ||||
| 151 | } | ||||
| 152 | |||||
| 153 | sub after (&@) { | ||||
| 154 | my $test = shift; | ||||
| 155 | my $started; | ||||
| 156 | my $lag; | ||||
| 157 | grep $started ||= do { | ||||
| 158 | my $x = $lag; | ||||
| 159 | $lag = $test->(); | ||||
| 160 | $x | ||||
| 161 | }, @_; | ||||
| 162 | } | ||||
| 163 | |||||
| 164 | sub after_incl (&@) { | ||||
| 165 | my $test = shift; | ||||
| 166 | my $started; | ||||
| 167 | grep $started ||= $test->(), @_; | ||||
| 168 | } | ||||
| 169 | |||||
| 170 | sub before (&@) { | ||||
| 171 | my $test = shift; | ||||
| 172 | my $more = 1; | ||||
| 173 | grep $more &&= ! $test->(), @_; | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | sub before_incl (&@) { | ||||
| 177 | my $test = shift; | ||||
| 178 | my $more = 1; | ||||
| 179 | my $lag = 1; | ||||
| 180 | grep $more &&= do { | ||||
| 181 | my $x = $lag; | ||||
| 182 | $lag = ! $test->(); | ||||
| 183 | $x | ||||
| 184 | }, @_; | ||||
| 185 | } | ||||
| 186 | |||||
| 187 | sub indexes (&@) { | ||||
| 188 | my $test = shift; | ||||
| 189 | grep { | ||||
| 190 | local *_ = \$_[$_]; | ||||
| 191 | $test->() | ||||
| 192 | } 0 .. $#_; | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | sub lastval (&@) { | ||||
| 196 | my $test = shift; | ||||
| 197 | my $ix; | ||||
| 198 | for ( $ix = $#_; $ix >= 0; $ix-- ) { | ||||
| 199 | local *_ = \$_[$ix]; | ||||
| 200 | my $testval = $test->(); | ||||
| 201 | |||||
| 202 | # Simulate $_ as alias | ||||
| 203 | $_[$ix] = $_; | ||||
| 204 | return $_ if $testval; | ||||
| 205 | } | ||||
| 206 | return undef; | ||||
| 207 | } | ||||
| 208 | |||||
| 209 | sub firstval (&@) { | ||||
| 210 | my $test = shift; | ||||
| 211 | foreach ( @_ ) { | ||||
| 212 | return $_ if $test->(); | ||||
| 213 | } | ||||
| 214 | return undef; | ||||
| 215 | } | ||||
| 216 | |||||
| 217 | sub pairwise (&\@\@) { | ||||
| 218 | my $op = shift; | ||||
| 219 | |||||
| 220 | # Symbols for caller's input arrays | ||||
| 221 | use vars qw{ @A @B }; | ||||
| 222 | local ( *A, *B ) = @_; | ||||
| 223 | |||||
| 224 | # Localise $a, $b | ||||
| 225 | my ( $caller_a, $caller_b ) = do { | ||||
| 226 | my $pkg = caller(); | ||||
| 227 | no strict 'refs'; | ||||
| 228 | \*{$pkg.'::a'}, \*{$pkg.'::b'}; | ||||
| 229 | }; | ||||
| 230 | |||||
| 231 | # Loop iteration limit | ||||
| 232 | my $limit = $#A > $#B? $#A : $#B; | ||||
| 233 | |||||
| 234 | # This map expression is also the return value | ||||
| 235 | local( *$caller_a, *$caller_b ); | ||||
| 236 | map { | ||||
| 237 | # Assign to $a, $b as refs to caller's array elements | ||||
| 238 | ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] ); | ||||
| 239 | |||||
| 240 | # Perform the transformation | ||||
| 241 | $op->(); | ||||
| 242 | } 0 .. $limit; | ||||
| 243 | } | ||||
| 244 | |||||
| 245 | sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) { | ||||
| 246 | return each_arrayref(@_); | ||||
| 247 | } | ||||
| 248 | |||||
| 249 | sub each_arrayref { | ||||
| 250 | my @list = @_; # The list of references to the arrays | ||||
| 251 | my $index = 0; # Which one the caller will get next | ||||
| 252 | my $max = 0; # Number of elements in longest array | ||||
| 253 | |||||
| 254 | # Get the length of the longest input array | ||||
| 255 | foreach ( @list ) { | ||||
| 256 | unless ( ref $_ eq 'ARRAY' ) { | ||||
| 257 | require Carp; | ||||
| 258 | Carp::croak("each_arrayref: argument is not an array reference\n"); | ||||
| 259 | } | ||||
| 260 | $max = @$_ if @$_ > $max; | ||||
| 261 | } | ||||
| 262 | |||||
| 263 | # Return the iterator as a closure wrt the above variables. | ||||
| 264 | return sub { | ||||
| 265 | if ( @_ ) { | ||||
| 266 | my $method = shift; | ||||
| 267 | unless ( $method eq 'index' ) { | ||||
| 268 | require Carp; | ||||
| 269 | Carp::croak("each_array: unknown argument '$method' passed to iterator."); | ||||
| 270 | } | ||||
| 271 | |||||
| 272 | # Return current (last fetched) index | ||||
| 273 | return undef if $index == 0 || $index > $max; | ||||
| 274 | return $index - 1; | ||||
| 275 | } | ||||
| 276 | |||||
| 277 | # No more elements to return | ||||
| 278 | return if $index >= $max; | ||||
| 279 | my $i = $index++; | ||||
| 280 | |||||
| 281 | # Return ith elements | ||||
| 282 | return map $_->[$i], @list; | ||||
| 283 | } | ||||
| 284 | } | ||||
| 285 | |||||
| 286 | sub natatime ($@) { | ||||
| 287 | my $n = shift; | ||||
| 288 | my @list = @_; | ||||
| 289 | return sub { | ||||
| 290 | return splice @list, 0, $n; | ||||
| 291 | } | ||||
| 292 | } | ||||
| 293 | |||||
| 294 | sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) { | ||||
| 295 | my $max = -1; | ||||
| 296 | $max < $#$_ && ( $max = $#$_ ) foreach @_; | ||||
| 297 | map { | ||||
| 298 | my $ix = $_; | ||||
| 299 | map $_->[$ix], @_; | ||||
| 300 | } 0 .. $max; | ||||
| 301 | } | ||||
| 302 | |||||
| 303 | sub uniq (@) { | ||||
| 304 | my %seen = (); | ||||
| 305 | grep { not $seen{$_}++ } @_; | ||||
| 306 | } | ||||
| 307 | |||||
| 308 | sub minmax (@) { | ||||
| 309 | return unless @_; | ||||
| 310 | my $min = my $max = $_[0]; | ||||
| 311 | |||||
| 312 | for ( my $i = 1; $i < @_; $i += 2 ) { | ||||
| 313 | if ( $_[$i-1] <= $_[$i] ) { | ||||
| 314 | $min = $_[$i-1] if $min > $_[$i-1]; | ||||
| 315 | $max = $_[$i] if $max < $_[$i]; | ||||
| 316 | } else { | ||||
| 317 | $min = $_[$i] if $min > $_[$i]; | ||||
| 318 | $max = $_[$i-1] if $max < $_[$i-1]; | ||||
| 319 | } | ||||
| 320 | } | ||||
| 321 | |||||
| 322 | if ( @_ & 1 ) { | ||||
| 323 | my $i = $#_; | ||||
| 324 | if ($_[$i-1] <= $_[$i]) { | ||||
| 325 | $min = $_[$i-1] if $min > $_[$i-1]; | ||||
| 326 | $max = $_[$i] if $max < $_[$i]; | ||||
| 327 | } else { | ||||
| 328 | $min = $_[$i] if $min > $_[$i]; | ||||
| 329 | $max = $_[$i-1] if $max < $_[$i-1]; | ||||
| 330 | } | ||||
| 331 | } | ||||
| 332 | |||||
| 333 | return ($min, $max); | ||||
| 334 | } | ||||
| 335 | |||||
| 336 | sub part (&@) { | ||||
| 337 | my ($code, @list) = @_; | ||||
| 338 | my @parts; | ||||
| 339 | push @{ $parts[ $code->($_) ] }, $_ foreach @list; | ||||
| 340 | return @parts; | ||||
| 341 | } | ||||
| 342 | |||||
| 343 | sub _XScompiled { | ||||
| 344 | return 0; | ||||
| 345 | } | ||||
| 346 | |||||
| 347 | END_PERL | ||||
| 348 | 1 | 200ns | die $@ if $@; | ||
| 349 | |||||
| 350 | # Function aliases | ||||
| 351 | 1 | 2µs | *first_index = \&firstidx; | ||
| 352 | 1 | 500ns | *last_index = \&lastidx; | ||
| 353 | 1 | 600ns | *first_value = \&firstval; | ||
| 354 | 1 | 400ns | *last_value = \&lastval; | ||
| 355 | 1 | 400ns | *zip = \&mesh; | ||
| 356 | 1 | 400ns | *distinct = \&uniq; | ||
| 357 | |||||
| 358 | 1 | 21µs | 1; | ||
| 359 | |||||
| 360 | __END__ | ||||
# spent 132µs within List::MoreUtils::bootstrap which was called:
# once (132µs+0s) by DynaLoader::bootstrap at line 217 of DynaLoader.pm | |||||
# spent 184µs within List::MoreUtils::firstidx which was called 66 times, avg 3µs/call:
# 22 times (123µs+0s) by Moose::Exporter::_strip_traits at line 532 of Moose/Exporter.pm, avg 6µs/call
# 22 times (32µs+0s) by Moose::Exporter::_strip_meta_name at line 558 of Moose/Exporter.pm, avg 1µs/call
# 22 times (30µs+0s) by Moose::Exporter::_strip_metaclass at line 546 of Moose/Exporter.pm, avg 1µs/call | |||||
# spent 17µs within List::MoreUtils::uniq which was called 3 times, avg 6µs/call:
# 3 times (17µs+0s) by Moose::Exporter::_follow_also at line 151 of Moose/Exporter.pm, avg 6µs/call |