Commit | Line | Data |
---|---|---|
84d4ea48 JH |
1 | package sort; |
2 | ||
e2091bb6 | 3 | our $VERSION = '2.04'; |
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 | 8 | $sort::stable_bit = 0x00000100; |
afe59f35 | 9 | $sort::unstable_bit = 0x00000200; |
84d4ea48 JH |
10 | |
11 | use strict; | |
12 | ||
13 | sub import { | |
14 | shift; | |
15 | if (@_ == 0) { | |
16 | require Carp; | |
17 | Carp::croak("sort pragma requires arguments"); | |
18 | } | |
84d4ea48 | 19 | local $_; |
7b9ef140 | 20 | $^H{sort} //= 0; |
84d4ea48 | 21 | while ($_ = shift(@_)) { |
e2091bb6 | 22 | if ($_ eq 'stable') { |
7b9ef140 | 23 | $^H{sort} |= $sort::stable_bit; |
afe59f35 | 24 | $^H{sort} &= ~$sort::unstable_bit; |
7a8ff2dd | 25 | } elsif ($_ eq 'defaults') { |
7b9ef140 | 26 | $^H{sort} = 0; |
7a8ff2dd JL |
27 | } else { |
28 | require Carp; | |
29 | Carp::croak("sort: unknown subpragma '$_'"); | |
30 | } | |
31 | } | |
32 | } | |
33 | ||
34 | sub unimport { | |
35 | shift; | |
36 | if (@_ == 0) { | |
37 | require Carp; | |
38 | Carp::croak("sort pragma requires arguments"); | |
39 | } | |
40 | local $_; | |
41 | no warnings 'uninitialized'; # bitops would warn | |
42 | while ($_ = shift(@_)) { | |
e2091bb6 | 43 | if ($_ eq 'stable') { |
7b9ef140 | 44 | $^H{sort} &= ~$sort::stable_bit; |
afe59f35 | 45 | $^H{sort} |= $sort::unstable_bit; |
84d4ea48 JH |
46 | } else { |
47 | require Carp; | |
71c4de84 | 48 | Carp::croak("sort: unknown subpragma '$_'"); |
84d4ea48 JH |
49 | } |
50 | } | |
51 | } | |
52 | ||
53 | sub current { | |
54 | my @sort; | |
7b9ef140 | 55 | if ($^H{sort}) { |
7b9ef140 | 56 | push @sort, 'stable' if $^H{sort} & $sort::stable_bit; |
84d4ea48 | 57 | } |
84d4ea48 JH |
58 | join(' ', @sort); |
59 | } | |
60 | ||
61 | 1; | |
62 | __END__ | |
63 | ||
64 | =head1 NAME | |
65 | ||
66 | sort - perl pragma to control sort() behaviour | |
67 | ||
68 | =head1 SYNOPSIS | |
69 | ||
c53fc8a6 | 70 | use sort 'stable'; # guarantee stability |
7a8ff2dd JL |
71 | use sort 'defaults'; # revert to default behavior |
72 | no sort 'stable'; # stability not important | |
84d4ea48 | 73 | |
7b9ef140 RH |
74 | my $current; |
75 | BEGIN { | |
e2091bb6 | 76 | $current = sort::current(); # identify prevailing pragmata |
7b9ef140 | 77 | } |
84d4ea48 JH |
78 | |
79 | =head1 DESCRIPTION | |
80 | ||
7a8ff2dd JL |
81 | With the C<sort> pragma you can control the behaviour of the builtin |
82 | C<sort()> function. | |
84d4ea48 | 83 | |
c53fc8a6 | 84 | A stable sort means that for records that compare equal, the original |
e2091bb6 | 85 | input ordering is preserved. |
c53fc8a6 JH |
86 | Stability will matter only if elements that compare equal can be |
87 | distinguished in some other way. That means that simple numerical | |
88 | and lexical sorts do not profit from stability, since equal elements | |
89 | are indistinguishable. However, with a comparison such as | |
90 | ||
91 | { substr($a, 0, 3) cmp substr($b, 0, 3) } | |
92 | ||
93 | stability might matter because elements that compare equal on the | |
94 | first 3 characters may be distinguished based on subsequent characters. | |
e2091bb6 Z |
95 | |
96 | Whether sorting is stable by default is an accident of implementation | |
97 | that can change (and has changed) between Perl versions. | |
98 | If stability is important, be sure to | |
7a8ff2dd JL |
99 | say so with a |
100 | ||
101 | use sort 'stable'; | |
102 | ||
103 | The C<no sort> pragma doesn't | |
104 | I<forbid> what follows, it just leaves the choice open. Thus, after | |
105 | ||
e2091bb6 | 106 | no sort 'stable'; |
7a8ff2dd | 107 | |
e2091bb6 | 108 | sorting may happen to be stable anyway. |
84d4ea48 | 109 | |
0e59b7c6 RGS |
110 | =head1 CAVEATS |
111 | ||
7b9ef140 RH |
112 | As of Perl 5.10, this pragma is lexically scoped and takes effect |
113 | at compile time. In earlier versions its effect was global and took | |
114 | effect at run-time; the documentation suggested using C<eval()> to | |
115 | change the behaviour: | |
7a8ff2dd | 116 | |
e2091bb6 | 117 | { eval 'no sort "stable"'; # stability not wanted |
7a8ff2dd JL |
118 | print sort::current . "\n"; |
119 | @a = sort @b; | |
7b9ef140 | 120 | eval 'use sort "defaults"'; # clean up, for others |
7a8ff2dd | 121 | } |
7b9ef140 | 122 | { eval 'use sort qw(defaults stable)'; # force stability |
7a8ff2dd JL |
123 | print sort::current . "\n"; |
124 | @c = sort @d; | |
7b9ef140 | 125 | eval 'use sort "defaults"'; # clean up, for others |
7a8ff2dd | 126 | } |
7a8ff2dd | 127 | |
7b9ef140 RH |
128 | Such code no longer has the desired effect, for two reasons. |
129 | Firstly, the use of C<eval()> means that the sorting algorithm | |
130 | is not changed until runtime, by which time it's too late to | |
131 | have any effect. Secondly, C<sort::current> is also called at | |
132 | run-time, when in fact the compile-time value of C<sort::current> | |
133 | is the one that matters. | |
7a8ff2dd | 134 | |
7b9ef140 | 135 | So now this code would be written: |
7a8ff2dd | 136 | |
e2091bb6 | 137 | { no sort "stable"; # stability not wanted |
7b9ef140 | 138 | my $current; |
a78dbd06 | 139 | BEGIN { $current = sort::current; } |
7b9ef140 | 140 | print "$current\n"; |
7a8ff2dd | 141 | @a = sort @b; |
7b9ef140 | 142 | # Pragmas go out of scope at the end of the block |
7a8ff2dd | 143 | } |
7b9ef140 RH |
144 | { use sort qw(defaults stable); # force stability |
145 | my $current; | |
a78dbd06 | 146 | BEGIN { $current = sort::current; } |
7b9ef140 | 147 | print "$current\n"; |
7a8ff2dd | 148 | @c = sort @d; |
7a8ff2dd | 149 | } |
0e59b7c6 | 150 | |
84d4ea48 JH |
151 | =cut |
152 |