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