lib/sort.pm

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