Commit | Line | Data |
84d4ea48 |
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 |
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 |
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 | |