[Summary view] [Print] [Text view]

   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