lexicographic sorting doesn't go faster when the sorting function sees more structure

Main.hs

module Main where

import Criterion.Main
import Criterion
import Data.List
import Data.Foldable (toList)
import Data.Random
import Data.Monoid ((<>))

import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.Sequence as S

import Control.DeepSeq
import Data.Ord

stagedSort :: [[a] -> [[a]]] -> [a] -> [a]
stagedSort (cmp : cmps) xs = stagedSort cmps =<< cmp xs
stagedSort [] xs = xs

data P = P !Char !Int
       deriving (Eq,Ord)

instance NFData P where
    rnf x = x `seq` ()

main = do
  let genNS = do
        nsP <- sample $ shuffle [ P c n | c <- ['a' .. 'f'],
                                  n <- take 100 $ cycle [0 .. 10]]
        nsComma <- sample $ shuffle [ (c,n) | c <- ['a' .. 'f'],
                                  n <- take 100 $ cycle [0 .. 10]]
        return (nsP, nsComma)

  defaultMain [bgroup "sorting P"
                [env genNS $ \ ~(ns,_) -> bench "sortBy cmpSP" (nfElem (sortBy cmpSP) ns),
                 env genNS $ \ ~(ns,_) -> bench "sort" (nfElem sort ns),
                 env genNS $ \ ~(ns,_) -> bench "staged cmpSSP" (nfElem (stagedSort cmpSSP) ns)],
    bgroup "sorting (,)"
                [env genNS $ \ ~(_,ns) -> bench "sortBy cmpSC" (nfElem (sortBy cmpSC) ns),
                 env genNS $ \ ~(_,ns) -> bench "sort" (nfElem sort ns),
                 env genNS $ \ ~(_,ns) -> bench "staged cmpSSC" (nfElem (stagedSort cmpSSC) ns)
      ]]
{- Below, the SSP and SSC ought to be faster than the
finely tuned sort in the Data.List module, but they are not.
So the conclusion seems to be that we should continue to use
<> to create `a -> a -> Ordering` because exposing that
extra structure to this particular sorting algorithm (stagedSort)
doesn't help.

    benchmarking sorting P/sortBy cmpSP
    time                 328.8 ?s   (326.5 ?s .. 331.2 ?s)
                         0.999 R?   (0.998 R? .. 1.000 R?)
    mean                 324.2 ?s   (321.1 ?s .. 329.1 ?s)
    std dev              12.41 ?s   (9.198 ?s .. 20.02 ?s)
    variance introduced by outliers: 33% (moderately inflated)

    benchmarking sorting P/sort
    time                 318.4 ?s   (317.5 ?s .. 319.2 ?s)
                         1.000 R?   (0.999 R? .. 1.000 R?)
    mean                 324.5 ?s   (321.9 ?s .. 329.9 ?s)
    std dev              11.98 ?s   (8.156 ?s .. 18.97 ?s)
    variance introduced by outliers: 32% (moderately inflated)

    benchmarking sorting P/staged cmpSSP
    time                 345.5 ?s   (343.1 ?s .. 348.7 ?s)
                         0.999 R?   (0.999 R? .. 1.000 R?)
    mean                 343.9 ?s   (342.3 ?s .. 346.0 ?s)
    std dev              6.379 ?s   (4.829 ?s .. 8.261 ?s)
    variance introduced by outliers: 10% (moderately inflated)

    benchmarking sorting (,)/sortBy cmpSC
    time                 365.6 ?s   (361.7 ?s .. 369.3 ?s)
                         0.999 R?   (0.999 R? .. 1.000 R?)
    mean                 363.0 ?s   (361.8 ?s .. 364.8 ?s)
    std dev              5.261 ?s   (4.028 ?s .. 7.015 ?s)

    benchmarking sorting (,)/sort
    time                 402.1 ?s   (391.6 ?s .. 412.1 ?s)
                         0.993 R?   (0.990 R? .. 0.996 R?)
    mean                 394.6 ?s   (387.6 ?s .. 405.2 ?s)
    std dev              29.00 ?s   (22.01 ?s .. 43.22 ?s)
    variance introduced by outliers: 65% (severely inflated)

    benchmarking sorting (,)/staged cmpSSC
    time                 358.6 ?s   (348.9 ?s .. 371.5 ?s)
                         0.987 R?   (0.982 R? .. 0.992 R?)
    mean                 380.8 ?s   (365.6 ?s .. 404.4 ?s)
    std dev              66.67 ?s   (45.33 ?s .. 93.75 ?s)
    variance introduced by outliers: 92% (severely inflated)
-}

-- almost `whnf (length . f)` except it also forces each element
nfElem f x = whnf (foldr seq () . f) x

cmpSP = comparing (\(P c _) -> c) <>
        comparing (\(P _ i) -> i)

cmpSC = comparing fst <> comparing snd

cmpSSP = [ onM (\ (P c _) -> c),
         onIM (\(P _ i) -> i) ]

cmpSSC = [ onM fst, onIM snd]

onIM f xs = map toList $ IM.elems $ IM.fromListWith (<>)
            [ (f x, S.singleton x) | x <- xs ]
onM f xs = map toList $ M.elems $ M.fromListWith (<>)
            [ (f x, S.singleton x) | x <- xs ]