[ Index ] |
## PHP Cross Reference of Unnamed Project |

[Summary view] [Print] [Text view]

1 package sort; 2 3 our $VERSION = '2.01'; 4 5 # The hints for pp_sort are now stored in $^H{sort}; older versions 6 # of perl used the global variable $sort::hints. -- rjh 2005-12-19 7 8 $sort::quicksort_bit = 0x00000001; 9 $sort::mergesort_bit = 0x00000002; 10 $sort::sort_bits = 0x000000FF; # allow 256 different ones 11 $sort::stable_bit = 0x00000100; 12 13 use strict; 14 15 sub import { 16 shift; 17 if (@_ == 0) { 18 require Carp; 19 Carp::croak("sort pragma requires arguments"); 20 } 21 local $_; 22 $^H{sort} //= 0; 23 while ($_ = shift(@_)) { 24 if (/^_q(?:uick)?sort$/) { 25 $^H{sort} &= ~$sort::sort_bits; 26 $^H{sort} |= $sort::quicksort_bit; 27 } elsif ($_ eq '_mergesort') { 28 $^H{sort} &= ~$sort::sort_bits; 29 $^H{sort} |= $sort::mergesort_bit; 30 } elsif ($_ eq 'stable') { 31 $^H{sort} |= $sort::stable_bit; 32 } elsif ($_ eq 'defaults') { 33 $^H{sort} = 0; 34 } else { 35 require Carp; 36 Carp::croak("sort: unknown subpragma '$_'"); 37 } 38 } 39 } 40 41 sub unimport { 42 shift; 43 if (@_ == 0) { 44 require Carp; 45 Carp::croak("sort pragma requires arguments"); 46 } 47 local $_; 48 no warnings 'uninitialized'; # bitops would warn 49 while ($_ = shift(@_)) { 50 if (/^_q(?:uick)?sort$/) { 51 $^H{sort} &= ~$sort::sort_bits; 52 } elsif ($_ eq '_mergesort') { 53 $^H{sort} &= ~$sort::sort_bits; 54 } elsif ($_ eq 'stable') { 55 $^H{sort} &= ~$sort::stable_bit; 56 } else { 57 require Carp; 58 Carp::croak("sort: unknown subpragma '$_'"); 59 } 60 } 61 } 62 63 sub current { 64 my @sort; 65 if ($^H{sort}) { 66 push @sort, 'quicksort' if $^H{sort} & $sort::quicksort_bit; 67 push @sort, 'mergesort' if $^H{sort} & $sort::mergesort_bit; 68 push @sort, 'stable' if $^H{sort} & $sort::stable_bit; 69 } 70 push @sort, 'mergesort' unless @sort; 71 join(' ', @sort); 72 } 73 74 1; 75 __END__ 76 77 =head1 NAME 78 79 sort - perl pragma to control sort() behaviour 80 81 =head1 SYNOPSIS 82 83 use sort 'stable'; # guarantee stability 84 use sort '_quicksort'; # use a quicksort algorithm 85 use sort '_mergesort'; # use a mergesort algorithm 86 use sort 'defaults'; # revert to default behavior 87 no sort 'stable'; # stability not important 88 89 use sort '_qsort'; # alias for quicksort 90 91 my $current; 92 BEGIN { 93 $current = sort::current(); # identify prevailing algorithm 94 } 95 96 =head1 DESCRIPTION 97 98 With the C<sort> pragma you can control the behaviour of the builtin 99 C<sort()> function. 100 101 In Perl versions 5.6 and earlier the quicksort algorithm was used to 102 implement C<sort()>, but in Perl 5.8 a mergesort algorithm was also made 103 available, mainly to guarantee worst case O(N log N) behaviour: 104 the worst case of quicksort is O(N**2). In Perl 5.8 and later, 105 quicksort defends against quadratic behaviour by shuffling large 106 arrays before sorting. 107 108 A stable sort means that for records that compare equal, the original 109 input ordering is preserved. Mergesort is stable, quicksort is not. 110 Stability will matter only if elements that compare equal can be 111 distinguished in some other way. That means that simple numerical 112 and lexical sorts do not profit from stability, since equal elements 113 are indistinguishable. However, with a comparison such as 114 115 { substr($a, 0, 3) cmp substr($b, 0, 3) } 116 117 stability might matter because elements that compare equal on the 118 first 3 characters may be distinguished based on subsequent characters. 119 In Perl 5.8 and later, quicksort can be stabilized, but doing so will 120 add overhead, so it should only be done if it matters. 121 122 The best algorithm depends on many things. On average, mergesort 123 does fewer comparisons than quicksort, so it may be better when 124 complicated comparison routines are used. Mergesort also takes 125 advantage of pre-existing order, so it would be favored for using 126 C<sort()> to merge several sorted arrays. On the other hand, quicksort 127 is often faster for small arrays, and on arrays of a few distinct 128 values, repeated many times. You can force the 129 choice of algorithm with this pragma, but this feels heavy-handed, 130 so the subpragmas beginning with a C<_> may not persist beyond Perl 5.8. 131 The default algorithm is mergesort, which will be stable even if 132 you do not explicitly demand it. 133 But the stability of the default sort is a side-effect that could 134 change in later versions. If stability is important, be sure to 135 say so with a 136 137 use sort 'stable'; 138 139 The C<no sort> pragma doesn't 140 I<forbid> what follows, it just leaves the choice open. Thus, after 141 142 no sort qw(_mergesort stable); 143 144 a mergesort, which happens to be stable, will be employed anyway. 145 Note that 146 147 no sort "_quicksort"; 148 no sort "_mergesort"; 149 150 have exactly the same effect, leaving the choice of sort algorithm open. 151 152 =head1 CAVEATS 153 154 As of Perl 5.10, this pragma is lexically scoped and takes effect 155 at compile time. In earlier versions its effect was global and took 156 effect at run-time; the documentation suggested using C<eval()> to 157 change the behaviour: 158 159 { eval 'use sort qw(defaults _quicksort)'; # force quicksort 160 eval 'no sort "stable"'; # stability not wanted 161 print sort::current . "\n"; 162 @a = sort @b; 163 eval 'use sort "defaults"'; # clean up, for others 164 } 165 { eval 'use sort qw(defaults stable)'; # force stability 166 print sort::current . "\n"; 167 @c = sort @d; 168 eval 'use sort "defaults"'; # clean up, for others 169 } 170 171 Such code no longer has the desired effect, for two reasons. 172 Firstly, the use of C<eval()> means that the sorting algorithm 173 is not changed until runtime, by which time it's too late to 174 have any effect. Secondly, C<sort::current> is also called at 175 run-time, when in fact the compile-time value of C<sort::current> 176 is the one that matters. 177 178 So now this code would be written: 179 180 { use sort qw(defaults _quicksort); # force quicksort 181 no sort "stable"; # stability not wanted 182 my $current; 183 BEGIN { $current = print sort::current; } 184 print "$current\n"; 185 @a = sort @b; 186 # Pragmas go out of scope at the end of the block 187 } 188 { use sort qw(defaults stable); # force stability 189 my $current; 190 BEGIN { $current = print sort::current; } 191 print "$current\n"; 192 @c = sort @d; 193 } 194 195 =cut 196

title

Description

Body

title

Description

Body

title

Description

Body

title

Body

Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |