diff --git a/Data/Array/Vector/Algorithms/Combinators.hs b/Data/Array/Vector/Algorithms/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/Data/Array/Vector/Algorithms/Combinators.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE Rank2Types, TypeOperators #-}
+
+-- ---------------------------------------------------------------------------
+-- |
+-- Module      : Data.Array.Vector.Algorithms.Combinators
+-- Copyright   : (c) 2008-2009 Dan Doel
+-- Maintainer  : Dan Doel <dan.doel@gmail.com>
+-- Stability   : Experimental
+-- Portability : Non-portable (rank-2 types)
+--
+-- The purpose of this module is to supply various combinators for commonly
+-- used idioms for the algorithms in this package. Examples at the time of
+-- this writing include running an algorithm keyed on some function of the
+-- elements (but only computing said function once per element), and safely
+-- applying the algorithms on mutable arrays to immutable arrays.
+
+module Data.Array.Vector.Algorithms.Combinators
+       ( apply
+       , usingKeys
+       , usingIxKeys
+       ) where
+
+import Control.Monad.ST
+
+import Data.Ord
+
+import Data.Array.Vector
+import Data.Array.Vector.Algorithms.Common
+
+-- | Safely applies a mutable array algorithm to an immutable array.
+apply :: (UA e) => (forall s. MUArr e s -> ST s ()) -> UArr e -> UArr e
+apply algo v = newU (lengthU v) (\arr -> copyMU arr 0 v >> algo arr)
+
+-- | Uses a function to compute a key for each element which the
+-- algorithm should use in lieu of the actual element. For instance:
+--
+-- > usingKeys sortBy f arr
+--
+-- should produce the same results as:
+--
+-- > sortBy (comparing f) arr
+--
+-- the difference being that usingKeys computes each key only once
+-- which can be more efficient for expensive key functions.
+usingKeys :: (UA e, UA k, Ord k)
+          => (forall e'. (UA e') => Comparison e' -> MUArr e' s -> ST s ())
+          -> (e -> k)
+          -> MUArr e s
+          -> ST s ()
+usingKeys algo f arr = usingIxKeys algo (const f) arr
+{-# INLINE usingKeys #-}
+
+-- | As usingKeys, only the key function has access to the array index
+-- at which each element is stored.
+usingIxKeys :: (UA e, UA k, Ord k)
+            => (forall e'. (UA e') => Comparison e' -> MUArr e' s -> ST s ())
+            -> (Int -> e -> k)
+            -> MUArr e s
+            -> ST s ()
+usingIxKeys algo f arr = do
+  keys <- newMU (lengthMU arr)
+  fill len keys
+  algo (comparing fstS) (unsafeZipMU keys arr)
+ where
+ len = lengthMU arr
+ fill k keys
+   | k < 0     = return ()
+   | otherwise = readMU arr k >>= writeMU keys k . f k >> fill (k-1) keys
+{-# INLINE usingIxKeys #-}
diff --git a/Data/Array/Vector/Algorithms/Immutable.hs b/Data/Array/Vector/Algorithms/Immutable.hs
deleted file mode 100644
--- a/Data/Array/Vector/Algorithms/Immutable.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
--- ---------------------------------------------------------------------------
--- |
--- Module      : Data.Array.Vector.Algorithms.Immutable
--- Copyright   : (c) 2008 Dan Doel
--- Maintainer  : Dan Doel <dan.doel@gmail.com>
--- Stability   : Experimental
--- Portability : Non-portable (rank-2 types)
---
--- The purpose of this module is to apply the algorithms on mutable arrays
--- in other packages to immutable arrays. The idea is to copy the immutable
--- array into a mutable intermediate, perform the algorithm on the mutable
--- array, and freeze it, yielding a new immutable array.
-
-module Data.Array.Vector.Algorithms.Immutable ( apply ) where
-
-import Control.Monad.ST
-
-import Data.Array.Vector
-
--- | Safely applies a mutable array algorithm to an immutable array.
-apply :: (UA e) => (forall s. MUArr e s -> ST s ()) -> UArr e -> UArr e
-apply algo v = newU (lengthU v) (\arr -> copyMU arr 0 v >> algo arr)
diff --git a/Data/Array/Vector/Algorithms/Intro.hs b/Data/Array/Vector/Algorithms/Intro.hs
--- a/Data/Array/Vector/Algorithms/Intro.hs
+++ b/Data/Array/Vector/Algorithms/Intro.hs
@@ -145,15 +145,17 @@
  where
  len = u - l
  go 0 l m n = H.partialSortByBounds cmp a (m - l) l u
- go n l m u = do O.sort3ByIndex cmp a c l (u-1)
-                 p <- readMU a l
-                 mid <- partitionBy cmp a p (l+1) u
-                 swap a l (mid - 1)
-                 case compare m mid of
-                   GT -> do introsort cmp a (n-1) l (mid - 1)
-                            go (n-1) mid m u
-                   EQ -> introsort cmp a (n-1) l m
-                   LT -> go n l m (mid - 1)
+ go n l m u
+   | l == m    = return ()
+   | otherwise = do O.sort3ByIndex cmp a c l (u-1)
+                    p <- readMU a l
+                    mid <- partitionBy cmp a p (l+1) u
+                    swap a l (mid - 1)
+                    case compare m mid of
+                      GT -> do introsort cmp a (n-1) l (mid - 1)
+                               go (n-1) mid m u
+                      EQ -> introsort cmp a (n-1) l m
+                      LT -> go n l m (mid - 1)
   where c = (u + l) `div` 2
 {-# INLINE partialSortByBounds #-}
 
diff --git a/Data/Array/Vector/Algorithms/Merge.hs b/Data/Array/Vector/Algorithms/Merge.hs
--- a/Data/Array/Vector/Algorithms/Merge.hs
+++ b/Data/Array/Vector/Algorithms/Merge.hs
@@ -1,7 +1,7 @@
 -- ---------------------------------------------------------------------------
 -- |
 -- Module      : Data.Array.Vector.Algorithms.Merge
--- Copyright   : (c) 2008 Dan Doel
+-- Copyright   : (c) 2008-2009 Dan Doel
 -- Maintainer  : Dan Doel <dan.doel@gmail.com>
 -- Stability   : Experimental
 -- Portability : Portable
@@ -65,7 +65,7 @@
 {-# INLINE mergeSortWithBuf #-}
 
 merge :: (UA e) => Comparison e -> MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()
-merge cmp arr tmp l m u = do mcopyMU arr tmp l 0 uTmp
+merge cmp arr tmp l m u = do memcpyOffMU arr tmp l 0 uTmp
                              eTmp <- readMU tmp 0
                              eArr <- readMU arr m
                              loop 0 eTmp m eArr l
@@ -74,7 +74,7 @@
  uArr = u
  loop iTmp eTmp iArr eArr iIns
    | iTmp >= uTmp = return ()
-   | iArr >= uArr = mcopyMU tmp arr iTmp iIns (uTmp - iTmp)
+   | iArr >= uArr = memcpyOffMU tmp arr iTmp iIns (uTmp - iTmp)
    | otherwise    = case cmp eArr eTmp of
                       LT -> do writeMU arr iIns eArr
                                eArr <- readMU arr (iArr+1)
diff --git a/Data/Array/Vector/Algorithms/Optimal.hs b/Data/Array/Vector/Algorithms/Optimal.hs
--- a/Data/Array/Vector/Algorithms/Optimal.hs
+++ b/Data/Array/Vector/Algorithms/Optimal.hs
@@ -71,20 +71,20 @@
   case cmp a0 a1 of
     GT -> case cmp a0 a2 of
             GT -> case cmp a2 a1 of
-                    GT -> do writeMU a i a1
-                             writeMU a j a2
+                    LT -> do writeMU a i a2
                              writeMU a k a0
-                    _  -> do writeMU a i a2
+                    _  -> do writeMU a i a1
+                             writeMU a j a2
                              writeMU a k a0
             _  -> do writeMU a i a1
                      writeMU a j a0
     _  -> case cmp a1 a2 of
-            GT -> case cmp a2 a0 of
-                    GT -> do writeMU a j a2
+            GT -> case cmp a0 a2 of
+                    GT -> do writeMU a i a2
+                             writeMU a j a0
                              writeMU a k a1
-                    _  -> do writeMU a i a2
+                    _  -> do writeMU a j a2
                              writeMU a k a1
-                             writeMU a j a0
             _  -> return ()
 {-# INLINE sort3ByIndex #-}
 
@@ -105,88 +105,123 @@
   a2 <- readMU a k
   a3 <- readMU a l
   case cmp a0 a1 of
-    LT -> case cmp a1 a2 of
-            LT -> case cmp a1 a3 of
-                    LT -> case cmp a2 a3 of
-                            GT -> do writeMU a k a3
-                                     writeMU a l a2
-                            _  -> return ()
-                    _  -> do case cmp a0 a3 of
-                               LT -> writeMU a j a3
-                               _  -> do writeMU a j a0
-                                        writeMU a i a3
-                             writeMU a l a2
-                             writeMU a k a1
-            _  -> case cmp a0 a2 of
-                    LT -> case cmp a2 a3 of
-                            LT -> case cmp a1 a3 of
-                                    LT -> do writeMU a j a2
-                                             writeMU a k a1
-                                    _  -> do writeMU a l a1
+    GT -> case cmp a0 a2 of
+            GT -> case cmp a1 a2 of
+                    GT -> case cmp a1 a3 of
+                            GT -> case cmp a2 a3 of
+                                    GT -> do writeMU a i a3
                                              writeMU a j a2
-                                             writeMU a k a3
-                            _  -> case cmp a0 a3 of
-                                    LT -> do writeMU a l a1
+                                             writeMU a k a1
+                                             writeMU a l a0
+                                    _  -> do writeMU a i a2
                                              writeMU a j a3
-                                    _  -> do writeMU a i a3
-                                             writeMU a l a1
-                                             writeMU a j a0
-                    _  -> case cmp a0 a3 of
-                            LT -> do writeMU a i a2
-                                     case cmp a1 a3 of
-                                       LT -> writeMU a k a1
-                                       _  -> do writeMU a k a3
-                                                writeMU a l a1
+                                             writeMU a k a1
+                                             writeMU a l a0
+                            _  -> case cmp a0 a3 of
+                                    GT -> do writeMU a i a2
+                                             writeMU a j a1
+                                             writeMU a k a3
+                                             writeMU a l a0
+                                    _  -> do writeMU a i a2
+                                             writeMU a j a1
+                                             writeMU a k a0
+                                             writeMU a l a3
+                    _ -> case cmp a2 a3 of
+                           GT -> case cmp a1 a3 of
+                                   GT -> do writeMU a i a3
+                                            writeMU a j a1
+                                            writeMU a k a2
+                                            writeMU a l a0
+                                   _  -> do writeMU a i a1
+                                            writeMU a j a3
+                                            writeMU a k a2
+                                            writeMU a l a0
+                           _  -> case cmp a0 a3 of
+                                   GT -> do writeMU a i a1
+                                            writeMU a j a2
+                                            writeMU a k a3
+                                            writeMU a l a0
+                                   _  -> do writeMU a i a1
+                                            writeMU a j a2
+                                            writeMU a k a0
+                                            -- writeMU a l a3
+            _  -> case cmp a0 a3 of
+                    GT -> case cmp a1 a3 of
+                            GT -> do writeMU a i a3
+                                     -- writeMU a j a1
+                                     writeMU a k a0
+                                     writeMU a l a2
+                            _  -> do writeMU a i a1
+                                     writeMU a j a3
+                                     writeMU a k a0
+                                     writeMU a l a2
+                    _  -> case cmp a2 a3 of
+                            GT -> do writeMU a i a1
                                      writeMU a j a0
-                            _  -> case cmp a2 a3 of
-                                    LT -> do writeMU a i a2
+                                     writeMU a k a3
+                                     writeMU a l a2
+                            _  -> do writeMU a i a1
+                                     writeMU a j a0
+                                     -- writeMU a k a2
+                                     -- writeMU a l a3
+    _  -> case cmp a1 a2 of
+            GT -> case cmp a0 a2 of
+                    GT -> case cmp a0 a3 of
+                            GT -> case cmp a2 a3 of
+                                    GT -> do writeMU a i a3
+                                             writeMU a j a2
                                              writeMU a k a0
-                                             writeMU a j a3
                                              writeMU a l a1
-                                    _  -> do writeMU a j a2
+                                    _  -> do writeMU a i a2
+                                             writeMU a j a3
                                              writeMU a k a0
-                                             writeMU a i a3
                                              writeMU a l a1
-    _  -> case cmp a0 a2 of
-            LT -> case cmp a0 a3 of
-                    LT -> do writeMU a i a1
-                             writeMU a j a0
-                             case cmp a2 a3 of
-                               GT -> do writeMU a k a3
-                                        writeMU a l a2
-                               _  -> return ()
-                    _  -> do case cmp a1 a3 of
-                               LT -> do writeMU a i a1
-                                        writeMU a j a3
-                               _  -> writeMU a i a3
-                             writeMU a l a2
-                             writeMU a k a0
-            _  -> case cmp a1 a2 of
-                    LT -> case cmp a2 a3 of
-                            LT -> do writeMU a i a1
-                                     writeMU a j a2
-                                     case cmp a0 a3 of
-                                       LT -> writeMU a k a0
-                                       _  -> do writeMU a k a3
-                                                writeMU a l a0
-                            _  -> do case cmp a1 a3 of
-                                       LT -> do writeMU a i a1
-                                                writeMU a j a3
-                                       _  -> writeMU a i a3
-                                     writeMU a l a0
-                    _  -> case cmp a1 a3 of
-                            LT -> do writeMU a i a2
-                                     case cmp a0 a3 of
-                                       LT -> writeMU a k a0
-                                       _  -> do writeMU a k a3
-                                                writeMU a l a0
-                            _  -> case cmp a2 a3 of
-                                    LT -> do writeMU a i a2
+                            _  -> case cmp a1 a3 of
+                                    GT -> do writeMU a i a2
+                                             writeMU a j a0
+                                             writeMU a k a3
+                                             writeMU a l a1
+                                    _  -> do writeMU a i a2
+                                             writeMU a j a0
                                              writeMU a k a1
+                                             -- writeMU a l a3
+                    _  -> case cmp a2 a3 of
+                            GT -> case cmp a0 a3 of
+                                    GT -> do writeMU a i a3
+                                             writeMU a j a0
+                                             -- writeMU a k a2
+                                             writeMU a l a1
+                                    _  -> do -- writeMU a i a0
                                              writeMU a j a3
-                                             writeMU a l a0
-                                    _  -> do writeMU a i a3
-                                             writeMU a l a0
+                                             -- writeMU a k a2
+                                             writeMU a l a1
+                            _  -> case cmp a1 a3 of
+                                    GT -> do -- writeMU a i a0
                                              writeMU a j a2
+                                             writeMU a k a3
+                                             writeMU a l a1
+                                    _  -> do -- writeMU a i a0
+                                             writeMU a j a2
                                              writeMU a k a1
+                                             -- writeMU a l a3
+            _  -> case cmp a1 a3 of
+                    GT -> case cmp a0 a3 of
+                            GT -> do writeMU a i a3
+                                     writeMU a j a0
+                                     writeMU a k a1
+                                     writeMU a l a2
+                            _  -> do -- writeMU a i a0
+                                     writeMU a j a3
+                                     writeMU a k a1
+                                     writeMU a l a2
+                    _  -> case cmp a2 a3 of
+                            GT -> do -- writeMU a i a0
+                                     -- writeMU a j a1
+                                     writeMU a k a3
+                                     writeMU a l a2
+                            _  -> do -- writeMU a i a0
+                                     -- writeMU a j a1
+                                     -- writeMU a k a2
+                                     -- writeMU a l a3
+                                     return ()
 {-# INLINE sort4ByIndex #-}
diff --git a/Data/Array/Vector/Algorithms/Radix.hs b/Data/Array/Vector/Algorithms/Radix.hs
--- a/Data/Array/Vector/Algorithms/Radix.hs
+++ b/Data/Array/Vector/Algorithms/Radix.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeOperators #-}
 
 -- ---------------------------------------------------------------------------
 -- |
 -- Module      : Data.Array.Vector.Algorithms.Radix
--- Copyright   : (c) 2008 Dan Doel
+-- Copyright   : (c) 2008-2009 Dan Doel
 -- Maintainer  : Dan Doel <dan.doel@gmail.com>
 -- Stability   : Experimental
 -- Portability : Non-portable (scoped type variables, bang patterns)
@@ -33,7 +33,7 @@
 --
 --    > radix k e = (e `shiftR` (k*8)) .&. 256
 
-module Data.Array.Vector.Algorithms.Radix (sort, Radix(..)) where
+module Data.Array.Vector.Algorithms.Radix (sort, sortBy, Radix(..)) where
 
 import Control.Monad
 import Control.Monad.ST
@@ -63,7 +63,7 @@
   {-# INLINE size #-}
   radix 0 e = e .&. 255
   radix i e
-    | i == passes e - 1 = radix' (e + minBound)
+    | i == passes e - 1 = radix' (e `xor` minBound)
     | otherwise         = radix' e
    where radix' e = (e `shiftR` (i `shiftL` 3)) .&. 255
   {-# INLINE radix #-}
@@ -73,7 +73,7 @@
   {-# INLINE passes #-}
   size _ = 256
   {-# INLINE size #-}
-  radix _ e = fromIntegral e + 128
+  radix _ e = 255 .&. fromIntegral e `xor` 128 
   {-# INLINE radix #-}
 
 instance Radix Int16 where
@@ -82,7 +82,7 @@
   size _ = 256
   {-# INLINE size #-}
   radix 0 e = fromIntegral (e .&. 255)
-  radix 1 e = fromIntegral (((e + minBound) `shiftR` 8) .&. 255)
+  radix 1 e = fromIntegral (((e `xor` minBound) `shiftR` 8) .&. 255)
   {-# INLINE radix #-}
 
 instance Radix Int32 where
@@ -93,7 +93,7 @@
   radix 0 e = fromIntegral (e .&. 255)
   radix 1 e = fromIntegral ((e `shiftR` 8) .&. 255)
   radix 2 e = fromIntegral ((e `shiftR` 16) .&. 255)
-  radix 3 e = fromIntegral (((e + minBound) `shiftR` 24) .&. 255)
+  radix 3 e = fromIntegral (((e `xor` minBound) `shiftR` 24) .&. 255)
   {-# INLINE radix #-}
 
 instance Radix Int64 where
@@ -108,7 +108,7 @@
   radix 4 e = fromIntegral ((e `shiftR` 32) .&. 255)
   radix 5 e = fromIntegral ((e `shiftR` 40) .&. 255)
   radix 6 e = fromIntegral ((e `shiftR` 48) .&. 255)
-  radix 7 e = fromIntegral (((e + minBound) `shiftR` 56) .&. 255)
+  radix 7 e = fromIntegral (((e `xor` minBound) `shiftR` 56) .&. 255)
   {-# INLINE radix #-}
 
 instance Radix Word where
@@ -163,44 +163,114 @@
   radix 7 e = fromIntegral ((e `shiftR` 56) .&. 255)
   {-# INLINE radix #-}
 
+instance (Radix i, Radix j) => Radix (i :*: j) where
+  passes ~(i :*: j) = passes i + passes j
+  {-# INLINE passes #-}
+  size   ~(i :*: j) = size i `max` size j
+  {-# INLINE size #-}
+  radix k ~(i :*: j) | k < passes j = radix k j
+                     | otherwise    = radix (k - passes j) i
+  {-# INLINE radix #-}
+
 -- | Sorts an array based on the Radix instance.
 sort :: forall e s. Radix e => MUArr e s -> ST s ()
-sort arr = do
-  tmp    <- newMU len
-  count  <- newMU (size e)
-  prefix <- newMU (size e)
-  go False arr tmp count prefix 0
+sort arr = sortBy (passes e) (size e) radix arr
  where
- len = lengthMU arr
  e :: e
  e = undefined
- go !swap src dst count prefix k
-   | k < passes e = do zero 0 count
-                       countLoop 0 k src count
-                       writeMU prefix 0 0
-                       prefixLoop 1 0 count prefix
-                       moveLoop 0 k src dst prefix
-                       go (not swap) dst src count prefix (k+1)
-   | otherwise    = when swap (mcopyMU src dst 0 0 len)
- zero i a
-   | i < size e = writeMU a i 0 >> zero (i+1) a
-   | otherwise  = return ()
- countLoop i k src count
-   | i < len    = readMU src i >>= inc count . radix k >> countLoop (i+1) k src count
-   | otherwise  = return ()
- prefixLoop i pi count prefix
-   | i < size e = do ci <- readMU count (i-1)
-                     let pi' = pi + ci
-                     writeMU prefix i pi'
-                     prefixLoop (i+1) pi' count prefix
+{-# INLINE sort #-}
+
+-- | Radix sorts an array using custom radix information
+-- requires the number of passes to fully sort the array,
+-- the size of of auxiliary arrays necessary (should be
+-- one greater than the maximum value returned by the radix
+-- function), and a radix function, which takes the pass
+-- and an element, and returns the relevant radix.
+sortBy :: (UA e) => Int               -- ^ the number of passes
+                 -> Int               -- ^ the size of auxiliary arrays
+                 -> (Int -> e -> Int) -- ^ the radix function
+                 -> MUArr e s         -- ^ the array to be sorted
+                 -> ST s ()
+sortBy passes size rdx arr = do
+  tmp    <- newMU (lengthMU arr)
+  count  <- newMU (size)
+  prefix <- newMU (size)
+  radixLoop passes rdx arr tmp count prefix
+{-# INLINE sortBy #-}
+
+radixLoop :: (UA e) => Int               -- passes
+                    -> (Int -> e -> Int) -- radix function
+                    -> MUArr e s         -- array to sort
+                    -> MUArr e s         -- temporary array
+                    -> MUArr Int s       -- radix count array
+                    -> MUArr Int s       -- placement array
+                    -> ST s ()
+radixLoop passes rdx src dst count prefix = go False 0
+ where
+ len = lengthMU src
+ go swap k
+   | k < passes = if swap
+                    then body rdx dst src count prefix k >> go (not swap) (k+1)
+                    else body rdx src dst count prefix k >> go (not swap) (k+1)
+   | otherwise  = when swap (mcopyMU dst src 0 0 len)
+{-# INLINE radixLoop #-}
+
+body :: (UA e) => (Int -> e -> Int) -- radix function
+               -> MUArr e s         -- source array
+               -> MUArr e s         -- destination array
+               -> MUArr Int s       -- radix count
+               -> MUArr Int s       -- placement
+               -> Int               -- current pass
+               -> ST s ()
+body rdx src dst count prefix k = do
+  zero count
+  countLoop k rdx src count
+  writeMU prefix 0 0
+  prefixLoop count prefix
+  moveLoop k rdx src dst prefix
+{-# INLINE body #-}
+
+zero :: MUArr Int s -> ST s ()
+zero a = go 0
+ where
+ len = lengthMU a
+ go i
+   | i < len   = writeMU a i 0 >> go (i+1)
+   | otherwise = return ()
+{-# INLINE zero #-}
+
+countLoop :: (UA e) => Int -> (Int -> e -> Int) -> MUArr e s -> MUArr Int s -> ST s ()
+countLoop k rdx src count = go 0
+ where
+ len = lengthMU src
+ go i
+   | i < len    = readMU src i >>= inc count . rdx k >> go (i+1)
    | otherwise  = return ()
- moveLoop i k src dst prefix
+{-# INLINE countLoop #-}
+
+prefixLoop :: MUArr Int s -> MUArr Int s -> ST s ()
+prefixLoop count prefix = go 1 0
+ where
+ len = lengthMU count
+ go i pi
+   | i < len   = do ci <- readMU count (i-1)
+                    let pi' = pi + ci
+                    writeMU prefix i pi'
+                    go (i+1) pi'
+   | otherwise = return ()
+{-# INLINE prefixLoop #-}
+
+moveLoop :: (UA e) => Int -> (Int -> e -> Int) -> MUArr e s -> MUArr e s -> MUArr Int s -> ST s ()
+moveLoop k rdx src dst prefix = go 0
+ where
+ len = lengthMU src
+ go i
    | i < len    = do srci <- readMU src i
-                     pf   <- inc prefix (radix k srci)
+                     pf   <- inc prefix (rdx k srci)
                      writeMU dst pf srci
-                     moveLoop (i+1) k src dst prefix
+                     go (i+1)
    | otherwise  = return ()
-{-# INLINE sort #-}
+{-# INLINE moveLoop #-}
 
 inc :: MUArr Int s -> Int -> ST s Int
 inc arr i = readMU arr i >>= \e -> writeMU arr i (e+1) >> return e
diff --git a/Data/Array/Vector/Algorithms/TriHeap.hs b/Data/Array/Vector/Algorithms/TriHeap.hs
--- a/Data/Array/Vector/Algorithms/TriHeap.hs
+++ b/Data/Array/Vector/Algorithms/TriHeap.hs
@@ -3,7 +3,7 @@
 -- ---------------------------------------------------------------------------
 -- |
 -- Module      : Data.Array.Vector.Algorithms.TriHeap
--- Copyright   : (c) 2008 Dan Doel
+-- Copyright   : (c) 2008-2009 Dan Doel
 -- Maintainer  : Dan Doel <dan.doel@gmail.com>
 -- Stability   : Experimental
 -- Portability : Non-portable (type operators)
@@ -82,7 +82,9 @@
 -- array into the positions [l,k+l). The elements will be in
 -- no particular order.
 selectByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()
-selectByBounds cmp a k l u = heapify cmp a l (l + k) >> go l (l + k) u
+selectByBounds cmp a k l u
+  | l + k <= u = heapify cmp a l (l + k) >> go l (l + k) (u - 1)
+  | otherwise  = return ()
  where
  go l m u
    | u < m      = return ()
@@ -108,11 +110,22 @@
 -- | Moves the lowest k elements in the portion [l,u) of the array
 -- into positions [l,k+l), sorted.
 partialSortByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()
-partialSortByBounds cmp a k l u = do selectByBounds cmp a k l u
-                                     sortHeap cmp a l (l + 4) (l + k)
-                                     O.sort4ByOffset cmp a l
-                                     -- this technically does extra work for k < 4, but
-                                     -- I'm not sure that's a significant concern.
+partialSortByBounds cmp a k l u
+  -- this potentially does more work than absolutely required,
+  -- but using a heap to find the least 2 of 4 elements
+  -- seems unlikely to be better than just sorting all of them
+  -- with an optimal sort, and the latter is obviously index
+  -- correct.
+  | len <  2   = return ()
+  | len == 2   = O.sort2ByOffset cmp a l
+  | len == 3   = O.sort3ByOffset cmp a l
+  | len == 4   = O.sort4ByOffset cmp a l
+  | u <= l + k = sortByBounds cmp a l u
+  | otherwise  = do selectByBounds cmp a k l u
+                    sortHeap cmp a l (l + 4) (l + k)
+                    O.sort4ByOffset cmp a l
+ where
+ len = u - l
 {-# INLINE partialSortByBounds #-}
 
 -- | Constructs a heap in a portion of an array [l, u)
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2008 Dan Doel
+Copyright (c) 2008-2009 Dan Doel
 
 All rights reserved.
 
diff --git a/bench/Blocks.hs b/bench/Blocks.hs
new file mode 100644
--- /dev/null
+++ b/bench/Blocks.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Blocks where
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Array.Vector
+
+import System.CPUTime
+
+import System.Random.Mersenne
+
+-- Some conveniences for doing evil stuff in the ST monad.
+-- All the tests get run in IO, but uvector stuff happens
+-- in ST, so we temporarily coerce.
+clock :: ST s Integer
+clock = unsafeIOToST getCPUTime
+
+-- Strategies for filling the initial arrays
+rand :: (MTRandom e) => MTGen -> Int -> ST s e
+rand g _ = unsafeIOToST (random g)
+
+ascend :: Num e => Int -> ST s e
+ascend = return . fromIntegral
+
+descend :: Num e => e -> Int -> ST s e
+descend m n = return $ m - fromIntegral n
+
+modulo :: Integral e => e -> Int -> ST s e
+modulo m n = return $ fromIntegral n `mod` m
+
+-- This is the worst case for the median-of-three quicksort
+-- used in the introsort implementation.
+medianKiller :: Integral e => e -> Int -> ST s e
+medianKiller m n'
+  | n < k     = return $ if even n then n + 1 else n + k
+  | otherwise = return $ (n - k + 1) * 2
+ where
+ n = fromIntegral n'
+ k = m `div` 2
+{-# INLINE medianKiller #-}
+
+initialize :: (UA e) => MUArr e s -> Int -> (Int -> ST s e) -> ST s ()
+initialize arr len fill = init $ len - 1
+ where init n = fill n >>= writeMU arr n >> when (n > 0) (init $ n - 1)
+{-# INLINE initialize #-}
+
+speedTest :: (UA e) => Int
+                    -> (forall s. Int -> ST s e)
+                    -> (forall s. MUArr e s -> ST s ())
+                    -> IO Integer
+speedTest n fill algo = stToIO $ do
+  arr <- newMU n
+  initialize arr n fill
+  t0 <- clock
+  algo arr
+  t1 <- clock
+  return $ t1 - t0
+{-# INLINE speedTest #-}
+
+
diff --git a/bench/LICENSE b/bench/LICENSE
new file mode 100644
--- /dev/null
+++ b/bench/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2009 Dan Doel
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/bench/Main.hs b/bench/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/Main.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Main (main) where
+
+import Control.Monad.ST
+import Control.Monad.Error
+
+import Data.Char
+import Data.Ord  (comparing)
+import Data.List (maximumBy)
+import Data.Array.Vector
+
+import qualified Data.Array.Vector.Algorithms.Insertion as INS
+import qualified Data.Array.Vector.Algorithms.Intro     as INT
+import qualified Data.Array.Vector.Algorithms.TriHeap   as TH
+import qualified Data.Array.Vector.Algorithms.Merge     as M
+import qualified Data.Array.Vector.Algorithms.Radix     as R
+
+import System.Environment
+import System.Console.GetOpt
+import System.Random.Mersenne
+
+import Blocks
+
+-- Does nothing. For testing the speed/heap allocation of the building blocks.
+noalgo :: (UA e) => MUArr e s -> ST s ()
+noalgo _ = return ()
+
+-- Allocates a temporary buffer, like mergesort for similar purposes as noalgo.
+alloc :: (UA e) => MUArr e s -> ST s ()
+alloc arr | len <= 4  = arr `seq` return ()
+          | otherwise = (newMU (len `div` 2) :: ST s (MUArr Int s)) >> return ()
+ where len = lengthMU arr
+
+displayTime :: String -> Integer -> IO ()
+displayTime s elapsed = putStrLn $
+    s ++ " : " ++ show (fromIntegral elapsed / 1e12) ++ " seconds"
+
+run :: String -> IO Integer -> IO ()
+run s t = t >>= displayTime s
+
+sortSuite :: String -> MTGen -> Int -> (forall s. MUArr Int s -> ST s ()) -> IO ()
+sortSuite str g n sort = do
+  putStrLn $ "Testing: " ++ str
+  run "Random            " $ speedTest n (rand g >=> modulo n) sort
+  run "Sorted            " $ speedTest n ascend sort
+  run "Reverse-sorted    " $ speedTest n (descend n) sort
+  run "Random duplicates " $ speedTest n (rand g >=> modulo 1000) sort
+  let m = 4 * (n `div` 4)
+  run "Median killer     " $ speedTest m (medianKiller m) sort
+
+partialSortSuite :: String -> MTGen -> Int -> Int
+                 -> (forall s. MUArr Int s -> Int -> ST s ()) -> IO ()
+partialSortSuite str g n k sort = sortSuite str g n (\a -> sort a k)
+
+-- -----------------
+-- Argument handling
+-- -----------------
+
+data Algorithm = DoNothing
+               | Allocate
+               | InsertionSort
+               | IntroSort
+               | IntroPartialSort
+               | IntroSelect
+               | TriHeapSort
+               | TriHeapPartialSort
+               | TriHeapSelect
+               | MergeSort
+               | RadixSort
+               deriving (Show, Read, Enum, Bounded)
+
+data Options = O { algos :: [Algorithm], elems :: Int, portion :: Int, usage :: Bool } deriving (Show)
+
+defaultOptions :: Options
+defaultOptions = O [] 10000 1000 False
+
+type OptionsT = Options -> Either String Options
+
+options :: [OptDescr OptionsT]
+options = [ Option ['A']     ["algorithm"] (ReqArg parseAlgo "ALGO")
+               ("Specify an algorithm to be run. Options:\n" ++ algoOpts)
+          , Option ['n']     ["num-elems"] (ReqArg parseN    "INT")
+               "Specify the size of arrays in algorithms."
+          , Option ['k']     ["portion"]   (ReqArg parseK    "INT")
+               "Specify the number of elements to partial sort/select in\nrelevant algorithms."
+          , Option ['?','v'] ["help"]      (NoArg $ \o -> Right $ o { usage = True })
+               "Show options."
+          ]
+ where
+ allAlgos :: [Algorithm]
+ allAlgos = [minBound .. maxBound]
+ algoOpts = fmt allAlgos
+ fmt (x:y:zs) = '\t' : pad (show x) ++ show y ++ "\n" ++ fmt zs
+ fmt [x]      = '\t' : show x ++ "\n"
+ fmt []       = ""
+ size         = ("    " ++) . maximumBy (comparing length) . map show $ allAlgos
+ pad str      = zipWith const (str ++ repeat ' ') size
+
+parseAlgo :: String -> Options -> Either String Options
+parseAlgo "None" o = Right $ o { algos = [] }
+parseAlgo "All"  o = Right $ o { algos = [DoNothing .. RadixSort] }
+parseAlgo s      o = leftMap (\e -> "Unrecognized algorithm `" ++ e ++ "'")
+                     . fmap (\v -> o { algos = v : algos o }) $ readEither s
+
+leftMap :: (a -> b) -> Either a c -> Either b c
+leftMap f (Left a)  = Left (f a)
+leftMap _ (Right c) = Right c
+
+parseNum :: (Int -> Options) -> String -> Either String Options
+parseNum f = leftMap (\e -> "Invalid numeric argument `" ++ e ++ "'") . fmap f . readEither
+
+parseN, parseK :: String -> Options -> Either String Options
+parseN s o = parseNum (\n -> o { elems   = n }) s
+parseK s o = parseNum (\k -> o { portion = k }) s
+
+readEither :: Read a => String -> Either String a
+readEither s = case reads s of
+  [(x,t)] | all isSpace t -> Right x
+  _                       -> Left s
+
+runTest :: MTGen -> Int -> Int -> Algorithm -> IO ()
+runTest g n k alg = case alg of
+  DoNothing          -> sortSuite        "no algorithm"          g n   noalgo
+  Allocate           -> sortSuite        "allocate"              g n   alloc
+  InsertionSort      -> sortSuite        "insertion sort"        g n   INS.sort
+  IntroSort          -> sortSuite        "introsort"             g n   INT.sort
+  IntroPartialSort   -> partialSortSuite "partial introsort"     g n k INT.partialSort
+  IntroSelect        -> partialSortSuite "introselect"           g n k INT.select
+  TriHeapSort        -> sortSuite        "tri-heap sort"         g n   TH.sort
+  TriHeapPartialSort -> partialSortSuite "partial tri-heap sort" g n k TH.partialSort
+  TriHeapSelect      -> partialSortSuite "tri-heap select"       g n k TH.select
+  MergeSort          -> sortSuite        "merge sort"            g n   M.sort
+  RadixSort          -> sortSuite        "radix sort"            g n   R.sort
+  _                  -> putStrLn $ "Currently unsupported algorithm: " ++ show alg
+
+main :: IO ()
+main = do args <- getArgs
+          gen  <- getStdGen
+          case getOpt Permute options args of
+            (fs, _, []) -> case foldl (>>=) (Right defaultOptions) fs of
+              Left err   -> putStrLn $ usageInfo err options
+              Right opts | not (usage opts) ->
+                mapM_ (runTest gen (elems opts) (portion opts)) (algos opts)
+                         | otherwise -> putStrLn $ usageInfo "uvector-algorithms-bench" options
+            (_, _, errs) -> putStrLn $ usageInfo (concat errs) options
+
+
diff --git a/bench/RadSieve.hs b/bench/RadSieve.hs
new file mode 100644
--- /dev/null
+++ b/bench/RadSieve.hs
@@ -0,0 +1,97 @@
+-- ------------------------------------------------------------------
+--
+-- Module        : RadSieve
+-- Copyright     : (c) 2009 Dan Doel
+--
+-- ------------------------------------------------------------------
+-- An implementation of a radical sieve, inspired by solving Project
+-- Euler problem #124.
+--
+-- Reproduction fo the problem text:
+--
+-- The radical of n, rad(n), is the product of distinct prime factors
+-- of n. For example, 504 = 23 × 32 × 7, so rad(504) = 2 × 3 × 7 = 42.
+--
+-- If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n),
+-- and sorting on n if the radical values are equal, we get:
+--
+--   Unsorted                 Sorted
+--   n  rad(n)             n  rad(n)  k
+--   1    1                1    1     1
+--   2    2                2    2     2
+--   3    3                4    2     3
+--   4    2                8    2     4
+--   5    5                3    3     5
+--   6    6                9    3     6
+--   7    7                5    5     7
+--   8    2                6    6     8
+--   9    3                7    7     9
+--  10   10               10   10    10
+--
+-- Let E(k) be the kth element in the sorted n column; for example,
+-- E(4) = 8 and E(6) = 9.
+--
+-- If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000).
+
+module RadSieve where
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Array.Vector
+
+-- Radicals can be sieved as follows:
+--   set a[1,n] = 1
+--   for i from 2 to n
+--     if a[i] == 1     -- i must be prime
+--      then a[j*i] *= i for positive integers j, j*i <= n
+--      else do nothing -- i is composite, so its prime factors
+--                      -- have been accounted for
+--
+-- This sieves for radicals up to the given integer.
+radSieve :: Int -> ST s (MUArr Int s)
+radSieve n = do arr <- newMU (n + 1)
+                fill arr n
+                sieve arr 1
+                return arr
+ where
+ fill arr i   | i < 0     = return ()
+              | otherwise = writeMU arr i 1 >> fill arr (i-1)
+ sieve arr i  | n < i     = return ()
+              | otherwise = do e <- readMU arr i
+                               when (e == 1) $ mark arr i i
+                               sieve arr (i+1)
+ mark arr p j | n < j     = return ()
+              | otherwise =  readMU arr j >>= writeMU arr j . (*p)
+                          >> mark arr p (j+p)
+
+-- Computes the answer to the above Project Euler problem. The correct
+-- answer is only generated for a stable sorting function.
+stableSortedRad :: Int -> Int
+                -> (forall s e. UA e => Comparison e -> MUArr e s -> ST s ()) 
+                -> Int
+stableSortedRad n k sortBy = runST (do rads <- radSieve n
+                                       index <- newMU (n + 1)
+                                       fillUp index n
+                                       sortBy (comparing fstS)
+                                              (unsafeZipMU rads index)
+                                       readMU k index)
+ where
+ fillUp arr k | k < 0     = return ()
+              | otherwise = writeMU arr k k >> fillUp arr (k-1)
+
+-- Computes the answer to the above Project Euler problem. This version
+-- will generate the correct answer even for unstable sorts, but may be
+-- marginally slower.
+unstableSortedRad :: Int -> Int
+                  -> (forall s e. UA e => Comparison e -> MUArr e s -> ST s ()) 
+                  -> Int
+unstableSortedRad n k sortBy = runST (do rads <- radSieve n
+                                       index <- newMU (n + 1)
+                                       fillUp index n
+                                       sortBy compare (unsafeZipMU rads index)
+                                       readMU k index)
+ where
+ fillUp arr k | k < 0     = return ()
+              | otherwise = writeMU arr k k >> fillUp arr (k-1)
+
diff --git a/bench/uvector-algorithms-bench.cabal b/bench/uvector-algorithms-bench.cabal
new file mode 100644
--- /dev/null
+++ b/bench/uvector-algorithms-bench.cabal
@@ -0,0 +1,22 @@
+name:                   uvector-algorithms-bench
+version:                0.2
+license:                BSD3
+license-file:           LICENSE
+author:                 Dan Doel
+maintainer:             Dan Doel <dan.doel@gmail.com>
+homepage:               http://code.haskell.org/~doio/
+category:               Benchmark
+synopsis:               Benchmarks for uvector-algorithms
+description:            A suite of various benchmarks for verifying the
+                        performance of the algorithms in uvector-algorithms.
+build-type:             Simple
+cabal-version:          >= 1.2
+
+executable uvec-bench
+  build-depends:        base, mersenne-random, uvector, uvector-algorithms, mtl
+
+  ghc-options:          -Wall -O2
+  main-is:              Main.hs
+
+  extensions:
+      Rank2Types
diff --git a/tests/Optimal.hs b/tests/Optimal.hs
new file mode 100644
--- /dev/null
+++ b/tests/Optimal.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE TypeOperators #-}
+
+-- Exhaustive test sets for proper sorting and stability of
+-- optimal sorts
+
+module Optimal where
+
+import Control.Arrow
+import Control.Monad
+
+import Data.List
+import Data.Function
+
+import Data.Array.Vector
+
+interleavings :: [a] -> [a] -> [[a]]
+interleavings [       ] ys        =  [ys]
+interleavings xs        [       ] =  [xs]
+interleavings xs@(x:xt) ys@(y:yt) =  map (x:) (interleavings xt ys)
+                                  ++ map (y:) (interleavings xs yt)
+
+zipS [    ] _      = []
+zipS _      [    ] = []
+zipS (x:xs) (y:ys) = (x:*:y) : zipS xs ys
+
+monotones :: Int -> Int -> [[Int]]
+monotones k = atLeastOne 0
+ where
+ atLeastOne i 0 = [[]]
+ atLeastOne i n = map (i:) $ picks i (n-1)
+ picks _ 0             = [[]]
+ picks i n | i >= k    = [replicate n k]
+           | otherwise = map (i:) (picks i (n-1)) ++ atLeastOne (i+1) n
+
+
+stability :: Int -> [UArr (Int :*: Int)]
+stability n = concatMap ( map toU
+                        . foldM interleavings []
+                        . groupBy ((==) `on` fstS)
+                        . flip zipS [0..])
+              $ monotones (n-2) n
+
+sort2 :: [UArr Int]
+sort2 = map toU $ permutations [0,1]
+
+stability2 :: [UArr (Int :*: Int)]
+stability2 = [toU [0 :*: 0, 0 :*: 1]]
+
+sort3 :: [UArr Int]
+sort3 = map toU $ permutations [0..2]
+
+{-
+stability3 :: [UArr (Int :*: Int)]
+stability3 = map toU [ [0:*:0, 0:*:1, 0:*:2]
+                     , [0:*:0, 0:*:1, 1:*:2]
+                     , [0:*:0, 1:*:2, 0:*:1]
+                     , [1:*:2, 0:*:0, 0:*:1]
+                     , [0:*:0, 1:*:1, 1:*:2]
+                     , [1:*:1, 0:*:0, 1:*:2]
+                     , [1:*:1, 1:*:2, 0:*:0]
+                     ]
+-}
+
+sort4 :: [UArr Int]
+sort4 = map toU $ permutations [0..3]
+
diff --git a/tests/Properties.hs b/tests/Properties.hs
new file mode 100644
--- /dev/null
+++ b/tests/Properties.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Properties where
+
+import Optimal
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.List
+import Data.Ord
+
+import Data.Array.Vector
+
+import Data.Array.Vector.Algorithms.Optimal (Comparison)
+import Data.Array.Vector.Algorithms.Radix
+import Data.Array.Vector.Algorithms.Combinators
+
+import qualified Data.Map as M
+
+import Test.QuickCheck
+
+import Util
+
+prop_sorted :: (UA e, Ord e) => UArr e -> Property
+prop_sorted arr | lengthU arr < 2 = property True
+                | otherwise       = check (headU arr) (tailU arr)
+ where
+ check e arr | nullU arr = property True
+             | otherwise = e <= headU arr .&. check (headU arr) (tailU arr)
+
+prop_fullsort :: (UA e, Ord e)
+              => (forall s. MUArr e s -> ST s ()) -> UArr e -> Property
+prop_fullsort algo arr = prop_sorted $ apply algo arr
+
+prop_schwartzian :: (UA e, UA k, Ord k)
+                 => (e -> k)
+                 -> (forall e s. (UA e) => (e -> e -> Ordering) -> MUArr e s -> ST s ())
+                 -> UArr e -> Property
+prop_schwartzian f algo arr
+  | lengthU arr < 2 = property True
+  | otherwise       = let srt = apply (algo `usingKeys` f) arr
+                      in check (headU srt) (tailU srt)
+ where
+ check e arr | nullU arr = property True
+             | otherwise = f e <= f (headU arr) .&. check (headU arr) (tailU arr)
+
+longGen :: (UA e, Arbitrary e) => Int -> Gen (UArr e)
+longGen k = liftM2 (\l r -> toU (l ++ r)) (vectorOf k arbitrary) arbitrary
+
+sanity :: Int
+sanity = 100
+
+prop_partialsort :: (UA e, Ord e, Arbitrary e, Show e)
+                 => (forall s. MUArr e s -> Int -> ST s ())
+                 -> Positive Int -> Property
+prop_partialsort = prop_sized $ \algo k ->
+  prop_sorted . takeU k . apply algo
+
+prop_select :: (UA e, Ord e, Arbitrary e, Show e)
+            => (forall s. MUArr e s -> Int -> ST s ())
+            -> Positive Int -> Property
+prop_select = prop_sized $ \algo k arr ->
+  let (l, r) = splitAtU k $ apply algo arr
+  in allU (\e -> allU (e <=) r) l
+
+prop_sized :: (UA e, Arbitrary e, Show e, Testable prop)
+           => ((forall s. MUArr e s -> ST s ()) -> Int -> UArr e -> prop)
+           -> (forall s. MUArr e s -> Int -> ST s ())
+           -> Positive Int -> Property
+prop_sized prop algo (Positive k) =
+  let k' = k `mod` sanity
+  in forAll (longGen k') $ prop (\marr -> algo marr k') k'
+
+prop_stable :: (forall e s. (UA e) => Comparison e -> MUArr e s -> ST s ())
+            -> UArr Int -> Property
+-- prop_stable algo arr = property $ apply algo arr == arr
+prop_stable algo arr = stable $ apply (algo (comparing fstS)) $ zipU arr ix
+ where
+ ix = toU [1 .. lengthU arr]
+
+stable arr | nullU arr = property True
+           | otherwise = let e :*: i = headU arr
+                         in allU (\(e' :*: i') -> e < e' || i < i') (tailU arr)
+                            .&. stable (tailU arr)
+
+prop_stable_radix :: (forall e s. UA e => 
+                                  Int -> Int -> (Int -> e -> Int) -> MUArr e s -> ST s ())
+                  -> UArr Int -> Property
+prop_stable_radix algo arr =
+  stable . apply (algo (passes e) (size e) (\k (e :*: _) -> radix k e))
+         $ zipU arr ix
+ where
+ ix = toU [1 .. lengthU arr]
+ e = headU arr
+ 
+prop_optimal :: Int
+             -> (forall e s. (UA e) => Comparison e -> MUArr e s -> Int -> ST s ())
+             -> Property
+prop_optimal n algo = label "sorting" sortn .&. label "stability" stabn
+ where
+ arrn  = toU [0..n-1]
+ sortn = all ( (== arrn)
+             . apply (\a -> algo compare a 0)
+             . toU)
+         $ permutations [0..n-1]
+ stabn = all ( (== arrn)
+             . sndS
+             . unzipU
+             . apply (\a -> algo (comparing fstS) a 0))
+         $ stability n
+
+type Bag e = M.Map e Int
+
+toBag :: (UA e, Ord e) => UArr e -> Bag e
+toBag = M.fromListWith (+) . flip zip (repeat 1) . fromU
+
+prop_permutation :: (UA e, Ord e)
+                 => (forall s. MUArr e s -> ST s ())
+                 -> UArr e -> Property
+prop_permutation algo arr = property $ 
+                            toBag arr == toBag (apply algo arr)
diff --git a/tests/Tests.hs b/tests/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/Tests.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE ImpredicativeTypes, RankNTypes, TypeOperators #-}
+
+module Main (main) where
+
+import Properties
+
+import Util
+
+import Test.QuickCheck
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Int
+import Data.Word
+
+import Data.Array.Vector
+
+import Data.Array.Vector.Algorithms.Combinators
+
+import qualified Data.Array.Vector.Algorithms.Insertion as INS
+import qualified Data.Array.Vector.Algorithms.Intro     as INT
+import qualified Data.Array.Vector.Algorithms.Merge     as M
+import qualified Data.Array.Vector.Algorithms.Radix     as R
+import qualified Data.Array.Vector.Algorithms.TriHeap   as TH
+import qualified Data.Array.Vector.Algorithms.Optimal   as O
+
+type Algo e = forall s. MUArr e s -> ST s ()
+type SizeAlgo e = forall s. MUArr e s -> Int -> ST s ()
+
+args = stdArgs
+       { maxSuccess = 300
+       , maxDiscard = 200
+       }
+
+check_Int_sort = forM_ algos $ \(name,algo) ->
+  quickCheckWith args (label name . prop_fullsort algo)
+ where
+ algos :: [(String, Algo Int)]
+ algos = [ ("introsort", INT.sort)
+         , ("insertion sort", INS.sort)
+         , ("merge sort", M.sort)
+         , ("tri-heapsort", TH.sort)
+         ]
+
+check_Int_partialsort = forM_ algos $ \(name,algo) ->
+  quickCheckWith args (label name . prop_partialsort algo)
+ where
+ algos :: [(String, SizeAlgo Int)]
+ algos = [ ("intro-partialsort", INT.partialSort)
+         , ("tri-heap partialsort", TH.partialSort)
+         ]
+
+check_Int_select = forM_ algos $ \(name,algo) ->
+  quickCheckWith args (label name . prop_select algo)
+ where
+ algos :: [(String, SizeAlgo Int)]
+ algos = [ ("intro-select", INT.select)
+         , ("tri-heap select", TH.select)
+         ]
+
+check_radix_sorts = do
+  qc (label "Word8"       . prop_fullsort (R.sort :: Algo Word8))
+  qc (label "Word16"      . prop_fullsort (R.sort :: Algo Word16))
+  qc (label "Word32"      . prop_fullsort (R.sort :: Algo Word32))
+  qc (label "Word64"      . prop_fullsort (R.sort :: Algo Word64))
+  qc (label "Word"        . prop_fullsort (R.sort :: Algo Word))
+  qc (label "Int8"        . prop_fullsort (R.sort :: Algo Int8))
+  qc (label "Int16"       . prop_fullsort (R.sort :: Algo Int16))
+  qc (label "Int32"       . prop_fullsort (R.sort :: Algo Int32))
+  qc (label "Int64"       . prop_fullsort (R.sort :: Algo Int64))
+  qc (label "Int"         . prop_fullsort (R.sort :: Algo Int))
+  qc (label "Int :*: Int" . prop_fullsort (R.sort :: Algo (Int :*: Int)))
+ where
+ qc algo = quickCheckWith args algo
+
+check_schwartzian = do
+  quickCheckWith args (prop_schwartzian i2w INS.sortBy)
+ where
+ i2w :: Int -> Word
+ i2w = fromIntegral
+
+check_stable = do quickCheckWith args (label "merge sort" . prop_stable M.sortBy)
+                  quickCheckWith args (label "radix sort" . prop_stable_radix R.sortBy)
+
+check_optimal = do qc . label "size 2" $ prop_optimal 2 O.sort2ByOffset
+                   qc . label "size 3" $ prop_optimal 3 O.sort3ByOffset
+                   qc . label "size 4" $ prop_optimal 4 O.sort4ByOffset
+ where
+ qc = quickCheck
+
+check_permutation = do
+  qc $ label "introsort"    . prop_permutation (INT.sort :: Algo Int)
+  qc $ label "intropartial" . prop_sized (const . prop_permutation)
+                                         (INT.partialSort :: SizeAlgo Int)
+  qc $ label "introselect"  . prop_sized (const . prop_permutation)
+                                         (INT.select :: SizeAlgo Int)
+  qc $ label "heapsort"     . prop_permutation (TH.sort :: Algo Int)
+  qc $ label "heappartial"  . prop_sized (const . prop_permutation)
+                                         (TH.partialSort :: SizeAlgo Int)
+  qc $ label "heapselect"   . prop_sized (const . prop_permutation)
+                                         (TH.select :: SizeAlgo Int)
+  qc $ label "mergesort"    . prop_permutation (M.sort :: Algo Int)
+  qc $ label "radix I8"     . prop_permutation (R.sort :: Algo Int8)
+  qc $ label "radix I16"    . prop_permutation (R.sort :: Algo Int16)
+  qc $ label "radix I32"    . prop_permutation (R.sort :: Algo Int32)
+  qc $ label "radix I64"    . prop_permutation (R.sort :: Algo Int64)
+  qc $ label "radix Int"    . prop_permutation (R.sort :: Algo Int)
+  qc $ label "radix W8"     . prop_permutation (R.sort :: Algo Word8)
+  qc $ label "radix W16"    . prop_permutation (R.sort :: Algo Word16)
+  qc $ label "radix W32"    . prop_permutation (R.sort :: Algo Word32)
+  qc $ label "radix W64"    . prop_permutation (R.sort :: Algo Word64)
+  qc $ label "radix Word"   . prop_permutation (R.sort :: Algo Word)
+ where
+ qc prop = quickCheckWith args prop
+
+
+main = do putStrLn "Int tests:"
+          check_Int_sort
+          check_Int_partialsort
+          check_Int_select
+          putStrLn "Radix sort tests:"
+          check_radix_sorts
+          putStrLn "Schwartzian transform (Int -> Word):"
+          check_schwartzian
+          putStrLn "Stability:"
+          check_stable
+          putStrLn "Optimals:"
+          check_optimal
+          putStrLn "Permutation:"
+          check_permutation
diff --git a/tests/Util.hs b/tests/Util.hs
new file mode 100644
--- /dev/null
+++ b/tests/Util.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE TypeOperators #-}
+
+module Util where
+
+import Control.Monad
+
+import Data.Word
+import Data.Int
+
+import Data.Array.Vector
+
+import Test.QuickCheck
+
+
+instance (Arbitrary e, UA e) => Arbitrary (UArr e) where
+  arbitrary = fmap toU arbitrary
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where
+  arbitrary = (:*:) `fmap` arbitrary `ap` arbitrary
+
+instance Arbitrary Int8 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Int16 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Int32 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Int64 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Word8 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Word16 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Word32 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Word64 where
+  arbitrary = fromInteger `fmap` arbitrary
+
+instance Arbitrary Word where
+  arbitrary = fromInteger `fmap` arbitrary
diff --git a/uvector-algorithms.cabal b/uvector-algorithms.cabal
--- a/uvector-algorithms.cabal
+++ b/uvector-algorithms.cabal
@@ -1,5 +1,5 @@
 Name:              uvector-algorithms
-Version:           0.1.1
+Version:           0.2
 License:           BSD3
 License-File:      LICENSE
 Author:            Dan Doel
@@ -11,13 +11,13 @@
                    be sure to compile with -O2, and -fvia-C -optc-O3 is
                    recommended.
 Build-Type:        Simple
-Cabal-Version:     >= 1.2
+Cabal-Version:     >= 1.2.3
 
 Library
-    Build-Depends: base, uvector
+    Build-Depends: base >= 3 && < 5, uvector >= 0.1.0.4
 
     Exposed-Modules:
-        Data.Array.Vector.Algorithms.Immutable
+        Data.Array.Vector.Algorithms.Combinators
         Data.Array.Vector.Algorithms.Optimal
         Data.Array.Vector.Algorithms.Insertion
         Data.Array.Vector.Algorithms.Intro
@@ -36,5 +36,4 @@
 
     GHC-Options:
         -O2
-        -fvia-C -optc-O3
         -funbox-strict-fields
