diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,15 @@
+## 0.2.1
+
+* `promises` 0.3 support
+* `vector` 0.11 support
+* `transformers` 0.5 support
+* `transformers-compat` support
+* ghc 8 support
+
+## 0.2
+
+* `grouping` is now much more efficient.
+
 ## 0.1
 
 * `grouping` is now productive. This means it can start spitting out results as it goes! To do this I created the `promises` package and switched to using it behind the scenes for many combinators that consume a `Group`. This has a bunch of knock-on effects:
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -1,7 +1,7 @@
 discrimination
 ==============
 
-[![Build Status](https://secure.travis-ci.org/ekmett/discrimination.png?branch=master)](http://travis-ci.org/ekmett/discrimination)
+[![Hackage](https://img.shields.io/hackage/v/discrimination.svg)](https://hackage.haskell.org/package/discrimination) [![Build Status](https://secure.travis-ci.org/ekmett/discrimination.png?branch=master)](http://travis-ci.org/ekmett/discrimination)
 
 This package provides linear time sorting, partitioning, and joins for a wide array of Haskell data types. This work is based on a
 "final encoding" of the ideas presented in [multiple](http://www.diku.dk/hjemmesider/ansatte/henglein/papers/henglein2011a.pdf) [papers](http://www.diku.dk/hjemmesider/ansatte/henglein/papers/henglein2011c.pdf) and [talks](https://www.youtube.com/watch?v=sz9ZlZIRDAg) by [Fritz Henglein](http://www.diku.dk/hjemmesider/ansatte/henglein/).
diff --git a/benchmarks/wordmap.hs b/benchmarks/wordmap.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/wordmap.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# OPTIONS_GHC -Wall -funbox-strict-fields -fno-warn-orphans -fno-warn-type-defaults -O2 #-}
+{-# OPTIONS_GHC -fno-full-laziness #-}
+module Main where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Criterion.Main
+import Criterion.Types
+import Data.Discrimination.Internal.WordMap
+import Data.Foldable
+import Data.HashMap.Lazy (HashMap)
+import Data.Maybe (fromMaybe)
+import Data.Word
+import Prelude hiding (lookup, length, foldr)
+import qualified Data.IntMap as M
+import qualified Data.HashMap.Lazy as H
+
+main :: IO ()
+main = do
+    evaluate $ rnf [denseM, sparseM, sparseM']
+    evaluate $ rnf [denseW, sparseW, sparseW']
+    evaluate $ rnf [denseH, sparseH, sparseH']
+    evaluate $ rnf [elems,  sElems,  sElemsSearch]
+    evaluate $ rnf [keys,   sKeys, sKeysSearch]
+    evaluate $ rnf [values, sValues]
+    evaluate $ rnf [welems,  wsElems,  wsElemsSearch]
+    evaluate $ rnf [wkeys,   wsKeys, wsKeysSearch]
+    evaluate $ rnf [wvalues, wsValues]
+    defaultMainWith (defaultConfig { timeLimit = 1 })
+        [ bgroup "lookup"
+            [ bgroup "present"
+                [ bench "IntMap"  $ whnf (\m -> foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 keys) denseM
+                , bench "WordMap" $ whnf (\m -> foldl' (\n k -> fromMaybe n (lookup k m)) 0 wkeys) denseW
+                , bench "HashMap" $ whnf (\m -> foldl' (\n k -> fromMaybe n (H.lookup k m)) 0 wkeys) denseH
+                ]
+            , bgroup "absent"
+                [ bench "IntMap"  $ whnf (\m -> foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 sKeysSearch) sparseM
+                , bench "WordMap" $ whnf (\m -> foldl' (\n k -> fromMaybe n (lookup k m)) 0 wsKeysSearch) sparseW
+                , bench "HashMap" $ whnf (\m -> foldl' (\n k -> fromMaybe n (H.lookup k m)) 0 wsKeysSearch) sparseH
+                ]
+            ]
+        , bgroup "insert"
+            [ bgroup "present"
+                [ bench "IntMap"  $ whnf (\m0 -> foldl' (\m (k, v) -> M.insert k v m) m0 elems) denseM
+                , bench "WordMap" $ whnf (\m0 -> foldl' (\m (k, v) -> insert k v m) m0 welems) denseW
+                , bench "HashMap" $ whnf (\m0 -> foldl' (\m (k, v) -> H.insert k v m) m0 welems) denseH
+                ]
+            , bgroup "absent"
+                [ bench "IntMap" $ whnf (\m0 -> foldl' (\m (k, v) -> M.insert k v m) m0 sElemsSearch) sparseM
+                , bench "WordMap" $ whnf (\m0 -> foldl' (\m (k, v) -> insert k v m) m0 wsElemsSearch) sparseW
+                , bench "HashMap" $ whnf (\m0 -> foldl' (\m (k, v) -> H.insert k v m) m0 wsElemsSearch) sparseH
+                ]
+            ]
+        , bgroup "member"
+            [ bgroup "present"
+                [ bench "IntMap"  $ whnf (\m -> foldl' (\n x -> if M.member x m then n + 1 else n) (0 :: Int) keys) denseM
+                , bench "WordMap" $ whnf (\m -> foldl' (\n x -> if member x m then n + 1 else n) (0 :: Int) wkeys) denseW
+                , bench "HashMap" $ whnf (\m -> foldl' (\n x -> if H.member x m then n + 1 else n) (0 :: Int) wkeys) denseH
+                ]
+            , bgroup "absent"
+                [ bench "IntMap"  $ whnf (\m -> foldl' (\n x -> if M.member x m then n + 1 else n) (0 :: Int) sKeysSearch) sparseM
+                , bench "WordMap" $ whnf (\m -> foldl' (\n x -> if member x m then n + 1 else n) (0 :: Int) wsKeysSearch) sparseW
+                , bench "HashMap" $ whnf (\m -> foldl' (\n x -> if H.member x m then n + 1 else n) (0 :: Int) wsKeysSearch) sparseH
+                ]
+            ]
+        ]
+  where
+    denseM = M.fromAscList elems :: M.IntMap Int
+    denseW = fromList welems :: WordMap Word64
+    denseH = H.fromList welems :: HashMap Word64 Word64
+    sparseM = M.fromAscList sElems :: M.IntMap Int
+    sparseW = fromList wsElems :: WordMap Word64
+    sparseH = H.fromList wsElems :: HashMap Word64 Word64
+    sparseM' = M.fromAscList sElemsSearch :: M.IntMap Int
+    sparseW' = fromList wsElemsSearch :: WordMap Word64
+    sparseH' = H.fromList wsElemsSearch :: HashMap Word64 Word64
+
+    elems = zip keys values
+    keys = [1..2^12]
+    values = [1..2^12]
+    sElems = zip sKeys sValues
+    sElemsSearch = zip sKeysSearch sValues
+    sKeys = [1,3..2^12]
+    sKeysSearch = [2,4..2^12]
+    sValues = [1,3..2^12]
+
+    welems = zip wkeys wvalues
+    wkeys = [1..2^12]
+    wvalues = [1..2^12]
+    wsElems = zip wsKeys wsValues
+    wsElemsSearch = zip wsKeysSearch wsValues
+    wsKeys = [1,3..2^12]
+    wsKeysSearch = [2,4..2^12]
+    wsValues = [1,3..2^12]
diff --git a/discrimination.cabal b/discrimination.cabal
--- a/discrimination.cabal
+++ b/discrimination.cabal
@@ -1,8 +1,8 @@
 name:          discrimination
 category:      Data, Sorting
-version:       0.1
+version:       0.2.1
 license:       BSD3
-cabal-version: >= 1.10
+cabal-version: >= 1.22
 license-file:  LICENSE
 author:        Edward A. Kmett
 maintainer:    Edward A. Kmett <ekmett@gmail.com>
@@ -11,7 +11,7 @@
 bug-reports:   http://github.com/ekmett/discrimination/issues
 copyright:     Copyright (C) 2014-2015 Edward A. Kmett
 build-type:    Simple
-tested-with:   GHC == 7.8.4
+tested-with:   GHC == 7.10.1
 synopsis:      Fast generic linear-time sorting, joins and container construction.
 description:
   This package provides fast, generic, linear-time discrimination and sorting.
@@ -38,6 +38,8 @@
     Data.Discrimination.Class
     Data.Discrimination.Grouping
     Data.Discrimination.Internal
+    Data.Discrimination.Internal.SmallArray
+    Data.Discrimination.Internal.WordMap
     Data.Discrimination.Sorting
 
   build-depends:
@@ -47,10 +49,28 @@
     contravariant >= 1.3.1  && < 2,
     deepseq       >= 1.3    && < 1.5,
     ghc-prim,
+    hashable      >= 1.2    && < 1.3,
     primitive     >= 0.6    && < 0.7,
     profunctors   >= 5      && < 6,
-    promises      >= 0.2    && < 0.3,
+    promises      >= 0.2    && < 0.4,
     semigroups    >= 0.16.2 && < 1,
-    transformers  >= 0.2    && < 0.5,
-    vector        >= 0.10   && < 0.11,
+    transformers  >= 0.2    && < 0.6,
+    transformers-compat >= 0.3 && < 1,
+    vector        >= 0.10   && < 0.12,
     void          >= 0.5    && < 1
+
+benchmark wordmap
+  type:             exitcode-stdio-1.0
+  main-is:          wordmap.hs
+  ghc-options:      -Wall -O2 -threaded 
+  hs-source-dirs:   benchmarks
+  default-language: Haskell2010
+  build-depends:
+    base >= 4.8,
+    containers,
+    criterion,
+    deepseq,
+    discrimination,
+    ghc-prim,
+    unordered-containers,
+    primitive
diff --git a/src/Data/Discrimination/Grouping.hs b/src/Data/Discrimination/Grouping.hs
--- a/src/Data/Discrimination/Grouping.hs
+++ b/src/Data/Discrimination/Grouping.hs
@@ -24,27 +24,27 @@
   , groupingEq
   , runGroup
   -- * Internals
-  , groupingNat
+  , hashing
   ) where
 
 import Control.Monad hiding (mapM_)
 import Control.Monad.Primitive
 import Control.Monad.ST
-import Data.Bits
 import Data.Complex
+import Data.Discrimination.Internal.WordMap as WordMap
 import Data.Foldable hiding (concat)
 import Data.Functor.Compose
 import Data.Functor.Contravariant
 import Data.Functor.Contravariant.Divisible
 import Data.Functor.Contravariant.Generic
+import Data.Hashable
 import Data.Int
-import Data.Monoid hiding (Any)
+import Data.Semigroup hiding (Any)
 import Data.Primitive.MutVar
 import Data.Promise
 import Data.Proxy
 import Data.Ratio
 import Data.Typeable
-import qualified Data.Vector.Mutable as UM
 import Data.Void
 import Data.Word
 import Prelude hiding (read, concat, mapM_)
@@ -83,21 +83,35 @@
 
   lose k = Group $ \_ -> return (absurd . k)
 
+instance Semigroup (Group a) where
+  (<>) = divide (\a -> (a,a))
+
 instance Monoid (Group a) where
   mempty = conquer
-  mappend = divide (\a -> (a,a))
+  mappend = (<>)
 
 --------------------------------------------------------------------------------
 -- Primitives
 --------------------------------------------------------------------------------
 
-groupingNat :: Int -> Group Int
-groupingNat = \ n -> Group $ \k -> do
-  t <- UM.replicate n Nothing
-  return $ \ a b -> UM.read t a >>= \case
-    Nothing -> k b >>= UM.write t a . Just
-    Just k' -> k' b
+groupingWord64 :: Group Word64
+groupingWord64 = Group $ \k -> do
+  mt <- newMutVar WordMap.empty
+  return $ \a b -> readMutVar mt >>= \m -> case WordMap.lookup a m of
+    Nothing -> k b >>= \p -> writeMutVar mt (insert a p m)
+    Just n -> n b
 
+-- | This may be useful for pragmatically accelerating a grouping structure by
+-- preclassifying by a hash function
+--
+-- Semantically,
+--
+-- @
+-- grouping = hashing <> grouping
+-- @
+hashing :: Hashable a => Group a
+hashing = contramap hash grouping
+
 --------------------------------------------------------------------------------
 -- * Unordered Discrimination (for partitioning)
 --------------------------------------------------------------------------------
@@ -119,52 +133,17 @@
 instance Grouping Void where
   grouping = lose id
 
-instance Grouping Word8 where
-  grouping = contramap fromIntegral (groupingNat 256)
-
-instance Grouping Word16 where
-  grouping = divide (\x -> (fromIntegral (unsafeShiftR x 8), fromIntegral x .&. 0xff)) (groupingNat 256) (groupingNat 256)
-
-instance Grouping Word32 where
-  grouping = divide (\x -> ( (fromIntegral (unsafeShiftR x 24)        , fromIntegral (unsafeShiftR x 16) .&. 0xff)
-                           , (fromIntegral (unsafeShiftR x 8) .&. 0xff, fromIntegral x                   .&. 0xff)
-                           )
-                    )
-    (divide id (groupingNat 256) (groupingNat 256))
-    (divide id (groupingNat 256) (groupingNat 256))
-
-instance Grouping Word64 where
-  grouping = divide (\x ->
-      ( ( (fromIntegral (unsafeShiftR x 56)         , fromIntegral (unsafeShiftR x 48) .&. 0xff)
-        , (fromIntegral (unsafeShiftR x 40) .&. 0xff, fromIntegral (unsafeShiftR x 32) .&. 0xff)
-        ),
-        ( (fromIntegral (unsafeShiftR x 24) .&. 0xff, fromIntegral (unsafeShiftR x 16) .&. 0xff)
-        , (fromIntegral (unsafeShiftR x 8)  .&. 0xff, fromIntegral x                   .&. 0xff)
-        )
-      )
-    )
-    (divide id (divide id (groupingNat 256) (groupingNat 256)) (divide id (groupingNat 256) (groupingNat 256)))
-    (divide id (divide id (groupingNat 256) (groupingNat 256)) (divide id (groupingNat 256) (groupingNat 256)))
-
-instance Grouping Word where
-  grouping
-    | (maxBound :: Word) == 4294967295 = contramap (fromIntegral :: Word -> Word32) grouping
-    | otherwise                        = contramap (fromIntegral :: Word -> Word64) grouping
-
-instance Grouping Int8 where
-  grouping = contramap (\x -> fromIntegral x + 128) (groupingNat 256)
-
-instance Grouping Int16 where
-  grouping = contramap (\x -> fromIntegral (x - minBound) :: Word16) grouping
-
-instance Grouping Int32 where
-  grouping = contramap (\x -> fromIntegral (x - minBound) :: Word32) grouping
-
-instance Grouping Int64 where
-  grouping = contramap (\x -> fromIntegral (x - minBound) :: Word64) grouping
-
-instance Grouping Int where
-  grouping = contramap (\x -> fromIntegral (x - minBound) :: Word) grouping
+instance Grouping Word8 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Word16 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Word32 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Word64 where grouping = groupingWord64
+instance Grouping Word where grouping = contramap fromIntegral groupingWord64
+instance Grouping Int8 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Int16 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Int32 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Int64 where grouping = contramap fromIntegral groupingWord64
+instance Grouping Int where grouping = contramap fromIntegral groupingWord64
+instance Grouping Char where grouping = contramap (fromIntegral . fromEnum) groupingWord64
 
 instance Grouping Bool
 instance (Grouping a, Grouping b) => Grouping (a, b)
@@ -208,7 +187,7 @@
   k a ()
   k b ()
   n <- readMutVar rn
-  return $ n == 2
+  return $ n == 1
 {-# INLINE groupingEq #-}
 
 runGroup :: Group a -> [(a,b)] -> [[b]]
@@ -237,7 +216,7 @@
 --
 -- This combinator still operates in linear time, at the expense of storing history.
 --
--- The result equivalence classes are _not_ sorted, but the grouping is stable.
+-- The result equivalence classes are __not__ sorted, but the grouping is stable.
 --
 -- @
 -- 'group' = 'groupWith' 'id'
@@ -247,7 +226,7 @@
 
 -- | /O(n)/. This is a replacement for 'GHC.Exts.groupWith' using discrimination.
 --
--- The result equivalence classes are _not_ sorted, but the grouping is stable.
+-- The result equivalence classes are __not__ sorted, but the grouping is stable.
 groupWith :: Grouping b => (a -> b) -> [a] -> [[a]]
 groupWith f as = runGroup grouping [(f a, a) | a <- as]
 
diff --git a/src/Data/Discrimination/Internal/SmallArray.hs b/src/Data/Discrimination/Internal/SmallArray.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Discrimination/Internal/SmallArray.hs
@@ -0,0 +1,232 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+--------------------------------------------------------------------------------
+-- |
+-- Copyright   : (c) Edward Kmett 2015
+-- License     : BSD-style
+-- Maintainer  : Edward Kmett <ekmett@gmail.com>
+-- Portability : non-portable
+--
+-- Small primitive boxed arrays
+--
+--------------------------------------------------------------------------------
+module Data.Discrimination.Internal.SmallArray (
+  SmallArray(..), SmallMutableArray(..),
+  newSmallArray, readSmallArray, writeSmallArray, indexSmallArray, indexSmallArrayM,
+  unsafeFreezeSmallArray, unsafeThawSmallArray, sameSmallMutableArray,
+  copySmallArray, copySmallMutableArray,
+  cloneSmallArray, cloneSmallMutableArray
+) where
+
+import Control.DeepSeq
+import Control.Monad.Primitive
+import Data.Foldable as Foldable
+import GHC.Exts
+import GHC.ST
+
+-- | Boxed arrays
+data SmallArray a = SmallArray (SmallArray# a)
+
+-- | Mutable boxed arrays associated with a primitive state token.
+data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)
+
+-- | Create a new mutable array of the specified size and initialise all
+-- elements with the given value.
+newSmallArray :: PrimMonad m => Int -> a -> m (SmallMutableArray (PrimState m) a)
+{-# INLINE newSmallArray #-}
+newSmallArray (I# n#) x = primitive
+   (\s# -> case newSmallArray# n# x s# of
+             (# s'#, arr# #) -> (# s'#, SmallMutableArray arr# #))
+
+-- | Read a value from the array at the given index.
+readSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m a
+{-# INLINE readSmallArray #-}
+readSmallArray (SmallMutableArray arr#) (I# i#) = primitive (readSmallArray# arr# i#)
+
+-- | Write a value to the array at the given index.
+writeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m ()
+{-# INLINE writeSmallArray #-}
+writeSmallArray (SmallMutableArray arr#) (I# i#) x = primitive_ (writeSmallArray# arr# i# x)
+
+-- | Read a value from the immutable array at the given index.
+indexSmallArray :: SmallArray a -> Int -> a
+{-# INLINE indexSmallArray #-}
+indexSmallArray (SmallArray arr#) (I# i#) = case indexSmallArray# arr# i# of (# x #) -> x
+
+-- | Monadically read a value from the immutable array at the given index.
+-- This allows us to be strict in the array while remaining lazy in the read
+-- element which is very useful for collective operations. Suppose we want to
+-- copy an array. We could do something like this:
+--
+-- > copy marr arr ... = do ...
+-- >                        writeSmallArray marr i (indexSmallArray arr i) ...
+-- >                        ...
+--
+-- But since primitive arrays are lazy, the calls to 'indexSmallArray' will not be
+-- evaluated. Rather, @marr@ will be filled with thunks each of which would
+-- retain a reference to @arr@. This is definitely not what we want!
+--
+-- With 'indexSmallArrayM', we can instead write
+--
+-- > copy marr arr ... = do ...
+-- >                        x <- indexSmallArrayM arr i
+-- >                        writeSmallArray marr i x
+-- >                        ...
+--
+-- Now, indexing is executed immediately although the returned element is
+-- still not evaluated.
+--
+indexSmallArrayM :: Monad m => SmallArray a -> Int -> m a
+{-# INLINE indexSmallArrayM #-}
+indexSmallArrayM (SmallArray arr#) (I# i#)
+  = case indexSmallArray# arr# i# of (# x #) -> return x
+
+-- | Convert a mutable array to an immutable one without copying. The
+-- array should not be modified after the conversion.
+unsafeFreezeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a)
+{-# INLINE unsafeFreezeSmallArray #-}
+unsafeFreezeSmallArray (SmallMutableArray arr#)
+  = primitive (\s# -> case unsafeFreezeSmallArray# arr# s# of
+                        (# s'#, arr'# #) -> (# s'#, SmallArray arr'# #))
+
+-- | Convert an immutable array to an mutable one without copying. The
+-- immutable array should not be used after the conversion.
+unsafeThawSmallArray :: PrimMonad m => SmallArray a -> m (SmallMutableArray (PrimState m) a)
+{-# INLINE unsafeThawSmallArray #-}
+unsafeThawSmallArray (SmallArray arr#)
+  = primitive (\s# -> case unsafeThawSmallArray# arr# s# of
+                        (# s'#, arr'# #) -> (# s'#, SmallMutableArray arr'# #))
+
+-- | Check whether the two arrays refer to the same memory block.
+sameSmallMutableArray :: SmallMutableArray s a -> SmallMutableArray s a -> Bool
+{-# INLINE sameSmallMutableArray #-}
+sameSmallMutableArray (SmallMutableArray arr#) (SmallMutableArray brr#)
+  = isTrue# (sameSmallMutableArray# arr# brr#)
+
+-- | Copy a slice of an immutable array to a mutable array.
+copySmallArray :: PrimMonad m
+          => SmallMutableArray (PrimState m) a    -- ^ destination array
+          -> Int                             -- ^ offset into destination array
+          -> SmallArray a                         -- ^ source array
+          -> Int                             -- ^ offset into source array
+          -> Int                             -- ^ number of elements to copy
+          -> m ()
+{-# INLINE copySmallArray #-}
+copySmallArray (SmallMutableArray dst#) (I# doff#) (SmallArray src#) (I# soff#) (I# len#)
+  = primitive_ (copySmallArray# src# soff# dst# doff# len#)
+
+-- | Copy a slice of a mutable array to another array. The two arrays may
+-- not be the same.
+copySmallMutableArray :: PrimMonad m
+          => SmallMutableArray (PrimState m) a    -- ^ destination array
+          -> Int                             -- ^ offset into destination array
+          -> SmallMutableArray (PrimState m) a    -- ^ source array
+          -> Int                             -- ^ offset into source array
+          -> Int                             -- ^ number of elements to copy
+          -> m ()
+{-# INLINE copySmallMutableArray #-}
+-- NOTE: copySmallArray# and copySmallMutableArray# are slightly broken in GHC 7.6.* and earlier
+copySmallMutableArray (SmallMutableArray dst#) (I# doff#)
+                 (SmallMutableArray src#) (I# soff#) (I# len#)
+  = primitive_ (copySmallMutableArray# src# soff# dst# doff# len#)
+
+-- | Return a newly allocated SmallArray with the specified subrange of the
+-- provided SmallArray. The provided SmallArray should contain the full subrange
+-- specified by the two Ints, but this is not checked.
+cloneSmallArray :: SmallArray a -- ^ source array
+           -> Int     -- ^ offset into destination array
+           -> Int     -- ^ number of elements to copy
+           -> SmallArray a
+{-# INLINE cloneSmallArray #-}
+cloneSmallArray (SmallArray arr#) (I# off#) (I# len#) 
+  = case cloneSmallArray# arr# off# len# of arr'# -> SmallArray arr'#
+
+-- | Return a newly allocated SmallMutableArray. with the specified subrange of
+-- the provided SmallMutableArray. The provided SmallMutableArray should contain the
+-- full subrange specified by the two Ints, but this is not checked.
+cloneSmallMutableArray :: PrimMonad m
+        => SmallMutableArray (PrimState m) a -- ^ source array
+        -> Int                          -- ^ offset into destination array
+        -> Int                          -- ^ number of elements to copy
+        -> m (SmallMutableArray (PrimState m) a)
+{-# INLINE cloneSmallMutableArray #-}
+cloneSmallMutableArray (SmallMutableArray arr#) (I# off#) (I# len#) = primitive
+   (\s# -> case cloneSmallMutableArray# arr# off# len# s# of
+             (# s'#, arr'# #) -> (# s'#, SmallMutableArray arr'# #))
+
+instance IsList (SmallArray a) where
+  type Item (SmallArray a) = a
+  toList = Foldable.toList
+  fromListN n xs0 = runST $ do
+    arr <- newSmallArray n undefined
+    let go !_ []     = return ()
+        go k (x:xs) = writeSmallArray arr k x >> go (k+1) xs
+    go 0 xs0
+    unsafeFreezeSmallArray arr
+  fromList xs = fromListN (Prelude.length xs) xs
+
+instance Functor SmallArray where
+  fmap f !i = runST $ do
+    let n = length i
+    o <- newSmallArray n undefined
+    let go !k
+          | k == n = return ()
+          | otherwise = do
+            a <- indexSmallArrayM i k
+            writeSmallArray o k (f a)
+            go (k+1)
+    go 0
+    unsafeFreezeSmallArray o
+
+instance Foldable SmallArray where
+  foldr f z arr = go 0 where
+    n = length arr
+    go !k
+      | k == n    = z
+      | otherwise = f (indexSmallArray arr k) (go (k+1))
+
+  foldl f z arr = go (length arr - 1) where
+    go !k
+      | k < 0 = z
+      | otherwise = f (go (k-1)) (indexSmallArray arr k)
+
+  foldr' f z arr = go 0 where
+    n = length arr
+    go !k
+      | k == n    = z
+      | r <- indexSmallArray arr k = r `seq` f r (go (k+1))
+
+  foldl' f z arr = go (length arr - 1) where
+    go !k
+      | k < 0 = z
+      | r <- indexSmallArray arr k = r `seq` f (go (k-1)) r
+
+  length (SmallArray ary) = I# (sizeofSmallArray# ary)
+  {-# INLINE length #-}
+
+instance Traversable SmallArray where
+  traverse f a = fromListN (length a) <$> traverse f (Foldable.toList a)
+
+instance Show a => Show (SmallArray a) where
+  showsPrec d as = showParen (d > 10) $
+    showString "fromList " . showsPrec 11 (Foldable.toList as)
+
+instance Read a => Read (SmallArray a) where
+  readsPrec d = readParen (d > 10) $ \s -> [(fromList m, u) | ("fromList", t) <- lex s, (m,u) <- readsPrec 11 t]
+
+instance Ord a => Ord (SmallArray a) where
+  compare as bs = compare (Foldable.toList as) (Foldable.toList bs)
+
+instance Eq a => Eq (SmallArray a) where
+  as == bs = Foldable.toList as == Foldable.toList bs
+
+instance NFData a => NFData (SmallArray a) where
+  rnf a0 = go a0 (length a0) 0 where
+    go !a !n !i
+      | i >= n = ()
+      | otherwise = rnf (indexSmallArray a i) `seq` go a n (i+1)
+  {-# INLINE rnf #-}
diff --git a/src/Data/Discrimination/Internal/WordMap.hs b/src/Data/Discrimination/Internal/WordMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Discrimination/Internal/WordMap.hs
@@ -0,0 +1,249 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# OPTIONS_GHC -Wall -funbox-strict-fields -fno-warn-orphans -fno-warn-type-defaults -O2 #-}
+#ifdef ST_HACK
+{-# OPTIONS_GHC -fno-full-laziness #-}
+#endif
+--------------------------------------------------------------------------------
+-- |
+-- Copyright   : (c) Edward Kmett 2015
+-- License     : BSD-style
+-- Maintainer  : Edward Kmett <ekmett@gmail.com>
+-- Portability : non-portable
+--
+-- This module suppose a Word64-based array-mapped PATRICIA Trie.
+--
+-- The most significant nybble is isolated by using techniques based on
+-- <https://www.fpcomplete.com/user/edwardk/revisiting-matrix-multiplication/part-4>
+-- but modified to work nybble-by-nybble rather than bit-by-bit.
+--
+--------------------------------------------------------------------------------
+module Data.Discrimination.Internal.WordMap
+  ( WordMap
+  , singleton
+  , empty
+  , insert
+  , lookup
+  , member
+  , fromList
+  ) where
+
+import Control.Applicative hiding (empty)
+import Control.DeepSeq
+import Control.Monad.ST hiding (runST)
+import Data.Bits
+import Data.Discrimination.Internal.SmallArray
+import Data.Foldable
+import Data.Functor
+import Data.Monoid
+import Data.Traversable
+import Data.Word
+import qualified GHC.Exts as Exts
+import Prelude hiding (lookup, length, foldr)
+import GHC.Types
+import GHC.ST
+
+type Key = Word64
+type Mask = Word16
+type Offset = Int
+
+ptrEq :: a -> a -> Bool
+ptrEq x y = isTrue# (Exts.reallyUnsafePtrEquality# x y Exts.==# 1#)
+{-# INLINEABLE ptrEq #-}
+
+ptrNeq :: a -> a -> Bool
+ptrNeq x y = isTrue# (Exts.reallyUnsafePtrEquality# x y Exts./=# 1#)
+{-# INLINEABLE ptrNeq #-}
+
+data WordMap v
+  = Full !Key !Offset !(SmallArray (WordMap v))
+  | Node !Key !Offset !Mask !(SmallArray (WordMap v))
+  | Tip  !Key v
+  | Nil
+  deriving Show
+
+node :: Key -> Offset -> Mask -> SmallArray (WordMap v) -> WordMap v
+node k o 0xffff a = Full k o a
+node k o m a      = Node k o m a
+{-# INLINE node #-}
+
+instance NFData v => NFData (WordMap v) where
+  rnf (Full _ _ a)   = rnf a
+  rnf (Node _ _ _ a) = rnf a
+  rnf (Tip _ v) = rnf v
+  rnf Nil = ()
+
+instance Functor WordMap where
+  fmap f = go where
+    go (Full k o a) = Full k o (fmap go a)
+    go (Node k o m a) = Node k o m (fmap go a)
+    go (Tip k v) = Tip k (f v)
+    go Nil = Nil
+  {-# INLINEABLE fmap #-}
+
+instance Foldable WordMap where
+  foldMap f = go where
+    go (Full _ _ a) = foldMap go a
+    go (Node _ _ _ a) = foldMap go a
+    go (Tip _ v) = f v
+    go Nil = mempty
+  {-# INLINEABLE foldMap #-}
+
+instance Traversable WordMap where
+  traverse f = go where
+    go (Full k o a) = Full k o <$> traverse go a
+    go (Node k o m a) = Node k o m <$> traverse go a
+    go (Tip k v) = Tip k <$> f v
+    go Nil = pure Nil
+  {-# INLINEABLE traverse #-}
+
+-- Note: 'level 0' will return a negative shift, don't use it
+level :: Key -> Int
+level w = 60 - (countLeadingZeros w .&. 0x7c)
+{-# INLINE level #-}
+
+maskBit :: Key -> Offset -> Int
+maskBit k o = fromIntegral (unsafeShiftR k o .&. 0xf)
+{-# INLINE maskBit #-}
+
+mask :: Key -> Offset -> Word16
+mask k o = unsafeShiftL 1 (maskBit k o)
+{-# INLINE mask #-}
+
+-- offset :: Int -> Word16 -> Int
+-- offset k w = popCount $ w .&. (unsafeShiftL 1 k - 1)
+-- {-# INLINE offset #-}
+
+fork :: Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
+fork o k n ok on = Node (k .&. unsafeShiftL 0xfffffffffffffff0 o) o (mask k o .|. mask ok o) $ runST $ do
+  arr <- newSmallArray 2 n
+  writeSmallArray arr (fromEnum (k < ok)) on
+  unsafeFreezeSmallArray arr
+
+insert :: Key -> v -> WordMap v -> WordMap v
+insert !k v xs0 = go xs0 where
+  go on@(Full ok n as)
+    | wd > 0xf = fork (level okk) k (Tip k v) ok on
+    | !oz <- indexSmallArray as d
+    , !z <- go oz
+    , ptrNeq z oz = Full ok n (update16 d z as)
+    | otherwise = on
+    where
+      okk = xor ok k
+      wd  = unsafeShiftR okk n
+      d   = fromIntegral wd
+  go on@(Node ok n m as)
+    | wd > 0xf = fork (level okk) k (Tip k v) ok on
+    | m .&. b == 0 = node ok n (m .|. b) (insertSmallArray odm (Tip k v) as)
+    | !oz <- indexSmallArray as odm
+    , !z <- go oz
+    , ptrNeq z oz = Node ok n m (updateSmallArray odm z as)
+    | otherwise = on
+    where
+      okk = xor ok k
+      wd  = unsafeShiftR okk n
+      d   = fromIntegral wd
+      b   = unsafeShiftL 1 d
+      odm = popCount $ m .&. (b - 1)
+  go on@(Tip ok ov)
+    | k /= ok    = fork (level (xor ok k)) k (Tip k v) ok on
+    | ptrEq v ov = on
+    | otherwise  = Tip k v
+  go Nil = Tip k v
+{-# INLINEABLE insert #-}
+
+
+lookup :: Key -> WordMap v -> Maybe v
+lookup !k (Full ok o a)
+  | z <- unsafeShiftR (xor k ok) o, z <= 0xf = lookup k $ indexSmallArray a (fromIntegral z)
+  | otherwise = Nothing
+lookup k (Node ok o m a)
+  | z <= 0xf && m .&. b /= 0 = lookup k (indexSmallArray a (popCount (m .&. (b - 1))))
+  | otherwise = Nothing
+  where
+    z = unsafeShiftR (xor k ok) o
+    b = unsafeShiftL 1 (fromIntegral z)
+lookup k (Tip ok ov)
+  | k == ok   = Just ov
+  | otherwise = Nothing
+lookup _ Nil = Nothing
+{-# INLINEABLE lookup #-}
+
+member :: Key -> WordMap v -> Bool
+member !k (Full ok o a)
+  | z <- unsafeShiftR (xor k ok) o = z <= 0xf && member k (indexSmallArray a (fromIntegral z))
+member k (Node ok o m a)
+  | z <- unsafeShiftR (xor k ok) o
+  = z <= 0xf && let b = unsafeShiftL 1 (fromIntegral z) in
+    m .&. b /= 0 && member k (indexSmallArray a (popCount (m .&. (b - 1))))
+member k (Tip ok _) = k == ok
+member _ Nil = False
+{-# INLINEABLE member #-}
+
+updateSmallArray :: Int -> a -> SmallArray a -> SmallArray a
+updateSmallArray !k a i = runST $ do
+  let n = length i
+  o <- newSmallArray n undefined
+  copySmallArray o 0 i 0 n
+  writeSmallArray o k a
+  unsafeFreezeSmallArray o
+{-# INLINEABLE updateSmallArray #-}
+
+update16 :: Int -> a -> SmallArray a -> SmallArray a
+update16 !k a i = runST $ do
+  o <- clone16 i
+  writeSmallArray o k a
+  unsafeFreezeSmallArray o
+{-# INLINEABLE update16 #-}
+
+insertSmallArray :: Int -> a -> SmallArray a -> SmallArray a
+insertSmallArray !k a i = runST $ do
+  let n = length i
+  o <- newSmallArray (n + 1) a
+  copySmallArray  o 0 i 0 k
+  copySmallArray  o (k+1) i k (n-k)
+  unsafeFreezeSmallArray o
+{-# INLINEABLE insertSmallArray #-}
+
+clone16 :: SmallArray a -> ST s (SmallMutableArray s a)
+clone16 i = do
+  o <- newSmallArray 16 undefined
+  indexSmallArrayM i 0 >>= writeSmallArray o 0
+  indexSmallArrayM i 1 >>= writeSmallArray o 1
+  indexSmallArrayM i 2 >>= writeSmallArray o 2
+  indexSmallArrayM i 3 >>= writeSmallArray o 3
+  indexSmallArrayM i 4 >>= writeSmallArray o 4
+  indexSmallArrayM i 5 >>= writeSmallArray o 5
+  indexSmallArrayM i 6 >>= writeSmallArray o 6
+  indexSmallArrayM i 7 >>= writeSmallArray o 7
+  indexSmallArrayM i 8 >>= writeSmallArray o 8
+  indexSmallArrayM i 9 >>= writeSmallArray o 9
+  indexSmallArrayM i 10 >>= writeSmallArray o 10
+  indexSmallArrayM i 11 >>= writeSmallArray o 11
+  indexSmallArrayM i 12 >>= writeSmallArray o 12
+  indexSmallArrayM i 13 >>= writeSmallArray o 13
+  indexSmallArrayM i 14 >>= writeSmallArray o 14
+  indexSmallArrayM i 15 >>= writeSmallArray o 15
+  return o
+{-# INLINE clone16 #-}
+
+-- | Build a singleton WordMap
+singleton :: Key -> v -> WordMap v
+singleton !k v = Tip k v
+{-# INLINE singleton #-}
+
+fromList :: [(Word64,v)] -> WordMap v
+fromList xs = foldl' (\r (k,v) -> insert k v r) Nil xs
+{-# INLINE fromList #-}
+
+empty :: WordMap a
+empty = Nil
+{-# INLINE empty #-}
diff --git a/src/Data/Discrimination/Sorting.hs b/src/Data/Discrimination/Sorting.hs
--- a/src/Data/Discrimination/Sorting.hs
+++ b/src/Data/Discrimination/Sorting.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE RoleAnnotations #-}
@@ -51,8 +50,8 @@
 import Data.IntSet as IntSet
 import qualified Data.List as List
 import Data.Map as Map
-import Data.Monoid hiding (Any)
 import Data.Proxy
+import Data.Semigroup hiding (Any)
 import Data.Set as Set
 import Data.Typeable
 import Data.Void
@@ -84,14 +83,17 @@
 
 instance Decidable Sort where
   lose k = Sort $ fmap (absurd.k.fst)
-  choose f (Sort l) (Sort r) = Sort $ \xs -> let 
+  choose f (Sort l) (Sort r) = Sort $ \xs -> let
       ys = fmap (first f) xs
     in l [ (k,v) | (Left k, v) <- ys]
     ++ r [ (k,v) | (Right k, v) <- ys]
 
+instance Semigroup (Sort a) where
+  Sort l <> Sort r = Sort $ \xs -> l [ (fst x, x) | x <- xs ] >>= r
+
 instance Monoid (Sort a) where
   mempty = conquer
-  mappend (Sort l) (Sort r) = Sort $ \xs -> l [ (fst x, x) | x <- xs ] >>= r
+  mappend = (<>)
 
 --------------------------------------------------------------------------------
 -- * Ordered Discrimination
@@ -150,6 +152,11 @@
 instance Sorting Int where
   sorting = contramap (\x -> fromIntegral (x - minBound) :: Word) sorting
 
+instance Sorting Char where
+  sorting = Sort (runs <=< runSort (sortingNat 1087) . join . runSort (sortingNat 1024) . fmap radices) where
+    radices (c,b) = (x .&. 0x3ff, (unsafeShiftR x 10, (x,b))) where
+      x = fromEnum c
+
 -- TODO: Integer and Natural?
 
 instance Sorting Void
@@ -239,7 +246,7 @@
 sort :: Sorting a => [a] -> [a]
 sort as = List.concat $ runSort sorting [ (a,a) | a <- as ]
 
--- | /O(n)/. Sort a list with a Schwartzian transformation by using discrimination. 
+-- | /O(n)/. Sort a list with a Schwartzian transformation by using discrimination.
 --
 -- This linear time replacement for 'GHC.Exts.sortWith' and 'Data.List.sortOn' uses discrimination.
 sortWith :: Sorting b => (a -> b) -> [a] -> [a]