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