[perl #127063] suppress warning on assigning 0 to $[
[perl.git] / lib / sort.pm
1 package sort;
2
3 our $VERSION = '2.03';
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 $sort::unstable_bit    = 0x00000200;
13
14 use strict;
15
16 sub import {
17     shift;
18     if (@_ == 0) {
19         require Carp;
20         Carp::croak("sort pragma requires arguments");
21     }
22     local $_;
23     $^H{sort} //= 0;
24     while ($_ = shift(@_)) {
25         if (/^_q(?:uick)?sort$/) {
26             $^H{sort} &= ~$sort::sort_bits;
27             $^H{sort} |=  $sort::quicksort_bit;
28         } elsif ($_ eq '_mergesort') {
29             $^H{sort} &= ~$sort::sort_bits;
30             $^H{sort} |=  $sort::mergesort_bit;
31         } elsif ($_ eq 'stable') {
32             $^H{sort} |=  $sort::stable_bit;
33             $^H{sort} &= ~$sort::unstable_bit;
34         } elsif ($_ eq 'defaults') {
35             $^H{sort} =   0;
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$/) {
53             $^H{sort} &= ~$sort::sort_bits;
54         } elsif ($_ eq '_mergesort') {
55             $^H{sort} &= ~$sort::sort_bits;
56         } elsif ($_ eq 'stable') {
57             $^H{sort} &= ~$sort::stable_bit;
58             $^H{sort} |=  $sort::unstable_bit;
59         } else {
60             require Carp;
61             Carp::croak("sort: unknown subpragma '$_'");
62         }
63     }
64 }
65
66 sub current {
67     my @sort;
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;
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
86     use sort 'stable';          # guarantee stability
87     use sort '_quicksort';      # use a quicksort algorithm
88     use sort '_mergesort';      # use a mergesort algorithm
89     use sort 'defaults';        # revert to default behavior
90     no  sort 'stable';          # stability not important
91
92     use sort '_qsort';          # alias for quicksort
93
94     my $current;
95     BEGIN {
96         $current = sort::current();     # identify prevailing algorithm
97     }
98
99 =head1 DESCRIPTION
100
101 With the C<sort> pragma you can control the behaviour of the builtin
102 C<sort()> function.
103
104 In Perl versions 5.6 and earlier the quicksort algorithm was used to
105 implement C<sort()>, but in Perl 5.8 a mergesort algorithm was also made
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
112 input ordering is preserved.  Mergesort is stable, quicksort is not.
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
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
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.
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.
154
155 =head1 CAVEATS
156
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:
161
162   { eval 'use sort qw(defaults _quicksort)'; # force quicksort
163     eval 'no sort "stable"';      # stability not wanted
164     print sort::current . "\n";
165     @a = sort @b;
166     eval 'use sort "defaults"';   # clean up, for others
167   }
168   { eval 'use sort qw(defaults stable)';     # force stability
169     print sort::current . "\n";
170     @c = sort @d;
171     eval 'use sort "defaults"';   # clean up, for others
172   }
173
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.
180
181 So now this code would be written:
182
183   { use sort qw(defaults _quicksort); # force quicksort
184     no sort "stable";      # stability not wanted
185     my $current;
186     BEGIN { $current = sort::current; }
187     print "$current\n";
188     @a = sort @b;
189     # Pragmas go out of scope at the end of the block
190   }
191   { use sort qw(defaults stable);     # force stability
192     my $current;
193     BEGIN { $current = sort::current; }
194     print "$current\n";
195     @c = sort @d;
196   }
197
198 =cut
199