Commit | Line | Data |
---|---|---|
84d4ea48 JH |
1 | package sort; |
2 | ||
3 | our $VERSION = '1.00'; | |
4 | ||
5 | $sort::hint_bits = 0x00020000; # HINT_LOCALIZE_HH, really... | |
6 | ||
7 | $sort::quicksort_bit = 0x00000001; | |
8 | $sort::mergesort_bit = 0x00000002; | |
9 | $sort::sort_bits = 0x000000FF; # allow 256 different ones | |
10 | $sort::stable_bit = 0x00000100; | |
11 | $sort::insensitive_bit = 0x00000200; | |
12 | $sort::safe_bits = 0x00000300; | |
13 | $sort::fast_bit = 0x00000400; | |
14 | ||
15 | use strict; | |
16 | ||
17 | sub import { | |
18 | shift; | |
19 | if (@_ == 0) { | |
20 | require Carp; | |
21 | Carp::croak("sort pragma requires arguments"); | |
22 | } | |
23 | $^H |= $sort::hint_bits; | |
24 | local $_; | |
726de688 | 25 | no warnings 'uninitialized'; # $^H{SORT} bitops would warn |
84d4ea48 JH |
26 | while ($_ = shift(@_)) { |
27 | if (/^q(?:uick)?sort$/) { | |
28 | $^H{SORT} &= ~$sort::sort_bits; | |
29 | $^H{SORT} |= $sort::quicksort_bit; | |
30 | return; | |
31 | } elsif ($_ eq 'mergesort') { | |
32 | $^H{SORT} &= ~$sort::sort_bits; | |
33 | $^H{SORT} |= $sort::mergesort_bit; | |
34 | return; | |
35 | } elsif ($_ eq 'safe') { | |
36 | $^H{SORT} &= ~$sort::fast_bit; | |
37 | $^H{SORT} |= $sort::safe_bits; | |
38 | $_ = 'mergesort'; | |
39 | redo; | |
40 | } elsif ($_ eq 'fast') { | |
41 | $^H{SORT} &= ~$sort::safe_bits; | |
42 | $^H{SORT} |= $sort::fast_bit; | |
43 | $_ = 'quicksort'; | |
44 | redo; | |
45 | } else { | |
46 | require Carp; | |
47 | Carp::croak("sort: unknown subpragma '@_'"); | |
48 | } | |
49 | } | |
50 | } | |
51 | ||
52 | sub current { | |
53 | my @sort; | |
54 | if ($^H{SORT}) { | |
55 | push @sort, 'quicksort' if $^H{SORT} & $sort::quicksort_bit; | |
56 | push @sort, 'mergesort' if $^H{SORT} & $sort::mergesort_bit; | |
57 | push @sort, 'safe' if $^H{SORT} & $sort::safe_bits; | |
58 | push @sort, 'fast' if $^H{SORT} & $sort::fast_bit; | |
59 | } | |
60 | push @sort, 'mergesort' unless @sort; | |
61 | join(' ', @sort); | |
62 | } | |
63 | ||
64 | 1; | |
65 | __END__ | |
66 | ||
67 | =head1 NAME | |
68 | ||
69 | sort - perl pragma to control sort() behaviour | |
70 | ||
71 | =head1 SYNOPSIS | |
72 | ||
73 | use sort 'quicksort'; | |
74 | use sort 'mergesort'; | |
75 | ||
76 | use sort 'qsort'; # alias for quicksort | |
77 | ||
726de688 | 78 | # alias for mergesort: insensitive and stable |
84d4ea48 JH |
79 | use sort 'safe'; |
80 | ||
81 | # alias for raw quicksort: sensitive and nonstable | |
82 | use sort 'fast'; | |
83 | ||
84 | my $current = sort::current(); | |
85 | ||
86 | =head1 DESCRIPTION | |
87 | ||
88 | With the sort pragma you can control the behaviour of the builtin | |
89 | sort() function. | |
90 | ||
91 | In Perl versions 5.6 and earlier the quicksort algorithm was used to | |
92 | implement sort(), but in Perl 5.8 the algorithm was changed to mergesort, | |
93 | mainly to guarantee insensitiveness to sort input: the worst case of | |
94 | quicksort is O(N**2), while mergesort is always O(N log N). | |
95 | ||
96 | On the other hand, for same cases (especially for shorter inputs) | |
97 | quicksort is faster. | |
98 | ||
99 | In Perl 5.8 and later by default quicksort is wrapped into a | |
100 | stabilizing layer. A stable sort means that for records that compare | |
101 | equal, the original input ordering is preserved. Mergesort is stable; | |
102 | quicksort is not. | |
103 | ||
104 | The metapragmas 'fast' and 'safe' select quicksort without the | |
105 | stabilizing layer and mergesort, respectively. In other words, | |
106 | 'safe' is the default. | |
107 | ||
108 | Finally, the sort performance is also dependent on the platform | |
109 | (smaller CPU caches favour quicksort). | |
110 | ||
111 | =cut | |
112 |