lib/sort.pm

   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 $_;
  25     no warnings 'uninitialized';        # $^H{SORT} bitops would warn
  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
  78     # alias for mergesort: insensitive and stable
  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