lib/perl5/5.8.8/sort.pm

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