diff --git a/lib/Data/Choose.hs b/lib/Data/Choose.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE Rank2Types #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+-- Immutable combinations.
+
+module Data.Choose (
+    -- * Combinations
+    Choose,
+    
+    -- * Creating combinations
+    choose,
+    listChoose,
+
+    -- * Accessing combination elements
+    at,
+    unsafeAt,
+
+    -- * Combination properties
+    possible,
+    size,
+    elems,
+    
+    -- * Combination functions
+    complement,
+    complElems,
+    next,
+    prev,
+    
+    ) where
+
+import Control.Monad
+import Control.Monad.ST
+import Data.Choose.Base
+import Data.Choose.ST
+
+-- | @choose n k@ returns the first combination of @k@ outcomes from @n@
+-- possibilites, namely the subset @{ 0, ..., k-1 }@.
+choose :: Int -> Int -> Choose
+choose n k = runST $
+    unsafeFreeze =<< newChoose n k
+
+-- | Construct a combination from a list of elements.  
+-- @listChoose n k is@ creates a combination of @k@ outcomes from @n@
+-- possibilities initialized to have the @i@th element equal to @is !! i@.  
+-- For the combination to be valid, the elements must all be unique, they 
+-- must be in sorted order, and they all must be in the range @0 .. n-1@.
+listChoose :: Int -> Int -> [Int] -> Choose
+listChoose n k is = runST $
+    unsafeFreeze =<< newListChoose n k is
+
+-- | @at c i@ gets the value of the @i@th element of the combination
+-- @c@.  The index @i@ must be in the range @0..(k-1)@, where @k@ is the
+-- size of the combination.
+at :: Choose -> Int -> Int
+at c i
+    | i >= 0 && i < size c =
+        unsafeAt c i
+    | otherwise =
+        error "Invalid index"
+{-# INLINE at #-}
+
+-- | Get the inverse of a combination
+complement :: Choose -> Choose
+complement c = runST $ 
+    unsafeFreeze =<< getComplement =<< unsafeThaw c
+
+-- | Get a list of the elements in the complement of a combination.
+-- If the combination is a subset of @k@ outcomes from @n@ possibilities, then
+-- the returned list will be sorted and of length @n-k@.  
+complElems :: Choose -> [Int]
+complElems c = runST $
+    getComplElems =<< unsafeThaw c
+
+-- | Return the next combination in lexicographic order, or @Nothing@ if
+-- there are no further combinations.  Starting with the first combination
+-- and repeatedly calling this function will iterate through all combinations
+-- of a given order.
+next :: Choose -> Maybe Choose
+next = nextPrevHelp setNext
+
+-- | Return the previous combination in lexicographic order, or @Nothing@
+-- if such combination exists.
+prev :: Choose -> Maybe Choose
+prev = nextPrevHelp setPrev
+
+nextPrevHelp :: (forall s. STChoose s -> ST s Bool) 
+             -> Choose -> Maybe Choose
+nextPrevHelp set c = runST $ do
+    c' <- thaw c
+    set c' >>= \valid ->
+        if valid
+            then liftM Just $ unsafeFreeze c'
+            else return Nothing
diff --git a/lib/Data/Choose/Base.hs b/lib/Data/Choose/Base.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose/Base.hs
@@ -0,0 +1,130 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose.Base
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+
+module Data.Choose.Base
+    where
+        
+import Control.Monad
+import Control.Monad.ST
+import Foreign
+
+import Data.IntArray ( IntArray, STIntArray )
+import qualified Data.IntArray as Arr
+import qualified Data.IntArray as ArrST
+
+
+--------------------------------- Choose ---------------------------------
+
+-- | The immutable combination data type.  A way of representing @k@
+-- unordered outcomes from @n@ possiblities.  The possibilites are
+-- represented as the indices @0, ..., n-1@, and the outcomes are
+-- given as a subset of size @k@.  The subset is stored with the indices
+-- in ascending order.
+data Choose = Choose {-# UNPACK #-} !Int      -- n
+                     {-# UNPACK #-} !IntArray -- the subset of size k
+
+unsafeAt :: Choose -> Int -> Int
+unsafeAt (Choose _ arr) i = Arr.unsafeAt arr i
+{-# INLINE unsafeAt #-}
+
+-- | Get the number of outcomes, @k@.
+size :: Choose -> Int
+size (Choose _ arr) = Arr.numElements arr
+{-# INLINE size #-}
+
+-- | Get the number of possibilities, @n@.
+possible :: Choose -> Int
+possible (Choose n _) = n
+{-# INLINE possible #-}
+
+-- | Get a list of the @k@ outcomes.
+elems :: Choose -> [Int]
+elems (Choose _ arr) = Arr.elems arr
+{-# INLINE elems #-}
+
+instance Show Choose where
+    show c = "listChoose " ++ show n ++ " " ++ show k ++ " " ++ show es
+      where
+        n  = possible c
+        k  = size c
+        es = elems c
+    
+instance Eq Choose where
+    (==) c1 c2 = (   (possible c1 == possible c2)
+                 &&      (size c1 == size c2)
+                 &&     (elems c1 == elems c2)
+                 )
+
+
+--------------------------------- STChoose --------------------------------
+
+-- | A mutable combination that can be manipulated in the 'ST' monad. The
+-- type argument @s@ is the state variable argument for the 'ST' type.
+data STChoose s = STChoose {-# UNPACK #-} !Int            -- n
+                           {-# UNPACK #-} !(STIntArray s) -- the subset
+
+getSizeSTChoose :: STChoose s -> ST s Int
+getSizeSTChoose (STChoose _ marr) = ArrST.getNumElements marr
+{-# INLINE getSizeSTChoose #-}
+
+sizeSTChoose :: STChoose s -> Int
+sizeSTChoose (STChoose _ marr) = ArrST.numElementsSTIntArray marr
+{-# INLINE sizeSTChoose #-}
+
+getPossibleSTChoose :: STChoose s -> ST s Int
+getPossibleSTChoose (STChoose n _) = return n
+{-# INLINE getPossibleSTChoose #-}
+
+possibleSTChoose :: STChoose s -> Int
+possibleSTChoose (STChoose n _) = n
+{-# INLINE possibleSTChoose #-}
+
+newSTChoose :: Int -> Int -> ST s (STChoose s)
+newSTChoose n k = do
+    c@(STChoose _ marr) <- newSTChoose_ n k
+    ArrST.writeElems marr [0 .. k-1]
+    return c
+{-# INLINE newSTChoose #-}
+
+newSTChoose_ :: Int -> Int -> ST s (STChoose s)
+newSTChoose_ n k = do
+    when (n < 0)          $ fail "invalid number of possibilities"
+    when (k < 0 || k > n) $ fail "invalid outcome size"
+    liftM (STChoose n) $ ArrST.newArray_ k
+{-# INLINE newSTChoose_ #-}
+
+unsafeGetElemSTChoose :: STChoose s -> Int -> ST s Int
+unsafeGetElemSTChoose (STChoose _ marr) i = ArrST.unsafeRead marr i
+{-# INLINE unsafeGetElemSTChoose #-}
+
+unsafeSetElemSTChoose :: STChoose s -> Int -> Int -> ST s ()
+unsafeSetElemSTChoose (STChoose _ marr) i x = ArrST.unsafeWrite marr i x
+{-# INLINE unsafeSetElemSTChoose #-}
+
+getElemsSTChoose :: STChoose s -> ST s [Int]
+getElemsSTChoose (STChoose _ marr) = ArrST.readElems marr
+{-# INLINE getElemsSTChoose #-}
+
+setElemsSTChoose :: STChoose s -> [Int] -> ST s ()
+setElemsSTChoose (STChoose _ marr) is = ArrST.writeElems marr is
+{-# INLINE setElemsSTChoose #-}
+
+unsafeFreezeSTChoose :: STChoose s -> ST s Choose
+unsafeFreezeSTChoose (STChoose n marr) = 
+    (liftM (Choose n) . ArrST.unsafeFreeze) marr
+{-# INLINE unsafeFreezeSTChoose #-}
+
+unsafeThawSTChoose :: Choose -> ST s (STChoose s)
+unsafeThawSTChoose (Choose n arr) =
+    (liftM (STChoose n) . ArrST.unsafeThaw) arr
+{-# INLINE unsafeThawSTChoose #-}
+
+instance Eq (STChoose s) where
+    (==) (STChoose _ marr1) (STChoose _ marr2) = 
+         ArrST.sameSTIntArray marr1 marr2
diff --git a/lib/Data/Choose/IO.hs b/lib/Data/Choose/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose/IO.hs
@@ -0,0 +1,20 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose.IO
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+-- Mutable combinations in the 'IO' monad.
+
+module Data.Choose.IO (
+    -- * Combinations
+    IOChoose,
+    
+    -- * Overloaded mutable combination interface
+    module Data.Choose.MChoose
+    ) where
+
+import Data.Choose.IOBase( IOChoose )
+import Data.Choose.MChoose
diff --git a/lib/Data/Choose/IOBase.hs b/lib/Data/Choose/IOBase.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose/IOBase.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose.IOBase
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+
+module Data.Choose.IOBase
+    where
+
+import Control.Monad
+import Control.Monad.ST
+import Data.Choose.Base
+
+-- | A mutable combination that can be manipulated in the 'IO' monad.
+newtype IOChoose = IOChoose (STChoose RealWorld) deriving Eq
+
+newIOChoose :: Int -> Int -> IO (IOChoose)
+newIOChoose n k = liftM IOChoose $ stToIO (newSTChoose n k)
+{-# INLINE newIOChoose #-}
+
+newIOChoose_ :: Int -> Int -> IO (IOChoose)
+newIOChoose_ n k = liftM IOChoose $ stToIO (newSTChoose_ n k)
+{-# INLINE newIOChoose_ #-}
+
+getPossibleIOChoose :: IOChoose -> IO Int
+getPossibleIOChoose (IOChoose c) = stToIO $ getPossibleSTChoose c
+{-# INLINE getPossibleIOChoose #-}
+
+possibleIOChoose :: IOChoose -> Int
+possibleIOChoose (IOChoose c) = possibleSTChoose c
+{-# INLINE possibleIOChoose #-}
+
+getSizeIOChoose :: IOChoose -> IO Int
+getSizeIOChoose (IOChoose c) = stToIO $ getSizeSTChoose c
+{-# INLINE getSizeIOChoose #-}
+
+sizeIOChoose :: IOChoose -> Int
+sizeIOChoose (IOChoose c) = sizeSTChoose c
+{-# INLINE sizeIOChoose #-}
+        
+unsafeGetElemIOChoose :: IOChoose -> Int -> IO Int
+unsafeGetElemIOChoose (IOChoose c) i = stToIO $ unsafeGetElemSTChoose c i
+{-# INLINE unsafeGetElemIOChoose #-}
+
+unsafeSetElemIOChoose :: IOChoose -> Int -> Int -> IO ()
+unsafeSetElemIOChoose (IOChoose c) i x = stToIO $ unsafeSetElemSTChoose c i x
+{-# INLINE unsafeSetElemIOChoose #-}
+
+getElemsIOChoose :: IOChoose -> IO [Int]
+getElemsIOChoose (IOChoose c) = stToIO $ getElemsSTChoose c
+{-# INLINE getElemsIOChoose #-}
+
+setElemsIOChoose :: IOChoose -> [Int] -> IO ()
+setElemsIOChoose (IOChoose c) is = stToIO $ setElemsSTChoose c is
+{-# INLINE setElemsIOChoose #-}
+
+unsafeFreezeIOChoose :: IOChoose -> IO Choose
+unsafeFreezeIOChoose (IOChoose c) = stToIO $ unsafeFreezeSTChoose c
+{-# INLINE unsafeFreezeIOChoose #-}
+
+unsafeThawIOChoose :: Choose -> IO (IOChoose)
+unsafeThawIOChoose c = liftM IOChoose $ stToIO (unsafeThawSTChoose c)
+{-# INLINE unsafeThawIOChoose #-}
diff --git a/lib/Data/Choose/MChoose.hs b/lib/Data/Choose/MChoose.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose/MChoose.hs
@@ -0,0 +1,327 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, 
+        FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose.MChoose
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+-- An overloaded interface to mutable combinations. For combination types which 
+-- can be used with this interface, see "Data.Choose.IO" and "Data.Choose.ST".
+--
+
+module Data.Choose.MChoose (
+    -- * Class of mutable combination types
+    MChoose, 
+
+    -- * Constructing mutable combinations
+    newChoose,
+    newChoose_,
+    newListChoose,
+    newCopyChoose,
+    copyChoose,
+    setFirst,
+    
+    -- * Accessing combination elements
+    getElem,
+    setElem,
+    
+    -- * Combination properties
+    getPossible,
+    getSize,
+    getElems,
+    setElems,
+    isValid,
+
+    -- * Combination functions
+    getComplement,
+    getComplElems,
+    setNext,
+    setPrev,
+    
+    -- * Converstions between mutable and immutable combinations
+    freeze,
+    unsafeFreeze,
+    thaw,
+    unsafeThaw,
+    
+    -- * Unsafe operations
+    unsafeNewListChoose,
+    unsafeGetElem,
+    unsafeSetElem,
+
+    ) where
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Choose.Base
+import Data.Choose.IOBase
+
+
+--------------------------------- MChoose --------------------------------
+
+-- | Class for representing a mutable combination.  The type is parameterized
+-- over the type of the monad, @m@, in which the mutable combination will be
+-- manipulated.
+class (Monad m) => MChoose c m | c -> m, m -> c where
+    -- | Get the number of possibilities, @n@ in the combination.
+    getPossible :: c -> m Int
+    
+    -- | Get the number of outcomes, @k@ in the combination.
+    getSize :: c -> m Int
+
+    -- | @newChoose n k@ creates a new combination of @k@ outcomes from @n@ 
+    -- possibilites initialized to the subset @{ 0, ..., k-1 }@.
+    newChoose :: Int -> Int -> m c
+
+    -- | @newChoose n k@ allocates a new combination of @k@ outcomes from
+    -- @n@ possibilities but does not initialize it.
+    newChoose_ :: Int -> Int -> m c
+
+    unsafeGetElem :: c -> Int -> m Int
+    unsafeSetElem :: c -> Int -> Int -> m ()
+
+    -- | Get a lazy list of the combination elements.  The laziness makes this
+    -- function slightly dangerous if you are modifying the combination.
+    getElems :: c -> m [Int]
+
+    -- | Set all the values of a combination from a list of elements.
+    setElems :: c -> [Int] -> m ()
+
+    unsafeFreeze :: c -> m Choose
+    unsafeThaw :: Choose -> m c
+    
+        
+-- | Construct a combination from a list of elements.  
+-- @newListChoose n k is@ creates a combination of @k@ outcomes from @n@
+-- possibilities initialized to have the @i@th element equal to @is !! i@.  
+-- For the combination to be valid, the elements must all be unique, they 
+-- must be in sorted order, and they all must be in the range @0 .. n-1@.
+newListChoose :: (MChoose c m) => Int -> Int -> [Int] -> m c
+newListChoose n k is = do
+    c <- unsafeNewListChoose n k is
+    valid <- isValid c
+    when (not valid) $ fail "invalid combination"
+    return c
+{-# INLINE newListChoose #-}
+
+unsafeNewListChoose :: (MChoose c m) => Int -> Int -> [Int] -> m c
+unsafeNewListChoose n k is = do
+    c <- newChoose_ n k
+    setElems c is
+    return c
+{-# INLINE unsafeNewListChoose #-}
+
+-- | Construct a new combination by copying another.
+newCopyChoose :: (MChoose c m) => c -> m c
+newCopyChoose c = do
+    n  <- getPossible c
+    k  <- getSize c
+    c' <- newChoose_ n k
+    copyChoose c' c
+    return c'
+{-# INLINE newCopyChoose #-}
+
+-- | @copyChoose dst src@ copies the elements of the combination @src@
+-- into the combination @dst@.  The two combinations must have the same
+-- size.
+copyChoose :: (MChoose c m) => c -> c -> m ()
+copyChoose dst src =
+    getElems src >>= setElems dst
+{-# INLINE copyChoose #-}
+
+-- | Set a combination to be the first subset of its size.
+setFirst :: (MChoose c m) => c -> m ()
+setFirst c = do
+    k <- getSize c
+    setElems c [0 .. k-1]
+{-# INLINE setFirst #-}
+
+-- | @getElem c i@ gets the value of the @i@th element of the combination
+-- @c@.  The index @i@ must be in the range @0..k-1@, where @n@ is the
+-- size of the combination.
+getElem :: (MChoose c m) => c -> Int -> m Int
+getElem c i = do
+    k <- getSize c
+    when (i < 0 || i >= k) $ fail "getElem: invalid index"
+    unsafeGetElem c i
+{-# INLINE getElem #-}
+
+-- | @setElem c i x@ sets the value of the @i@th element of the combination
+-- @c@.  The index @i@ must be in the range @0..k-1@, where @k@ is the
+-- size of the combination.
+setElem :: (MChoose c m) => c -> Int -> Int -> m ()
+setElem c i x = do
+    k <- getSize c
+    when (i < 0 || i >= k) $ fail "getElem: invalid index"
+    unsafeSetElem c i x
+{-# INLINE setElem #-}
+
+-- | Returns whether or not the combination is valid.  For it to be valid,
+-- the elements must all be unique, they must be in sorted order, and they
+-- all must be in the range @0 .. n-1@, where @n@ is the number of 
+-- possibilies in the combination.
+isValid :: (MChoose c m) => c -> m Bool
+isValid c = do
+    n  <- getPossible c
+    is <- getElems c
+    return $! go n (-1) is
+  where
+    go _ _ []     = True
+    go n j (i:is) = i > j && i < n && go n i is
+{-# INLINE isValid #-}
+
+-- | Compute the complement of a combination
+getComplement :: (MChoose c m) => c -> m c
+getComplement c = do
+    n <- getPossible c
+    k <- getSize c
+    d <- newChoose_ n (n-k)
+    setElems d =<< getComplElems c
+    return $! d
+{-# INLINE getComplement #-}
+
+-- | Return a lazy list of the elements in the complement of a combination.
+-- If the combination is a subset of @k@ outcomes from @n@ possibilities, then
+-- the returned list will be sorted and of length @n-k@.  
+-- Due to the laziness, you should be careful when using this function if you
+-- are also modifying the combination.
+getComplElems :: (MChoose c m) => c -> m [Int]
+getComplElems c = do
+    n  <- getPossible c
+    is <- getElems c
+    return $ go n is 0
+  where
+    go n []     j             = [j .. n-1]
+    go n (i:is) j | j == i    = go n is (j+1)
+                  | otherwise = [j .. i-1] ++ go n is (i+1)
+{-# INLINE getComplElems #-}
+
+-- | Advance a combination to the next in lexicogrphic order and return @True@. 
+--  If no further combinations are available, return @False@ and leave the 
+-- combination unmodified.  Starting with @[ 0 .. k-1 ]@ and repeatedly
+-- calling @setNext@ will iterate through all subsets of size @k@.
+setNext :: (MChoose c m) => c -> m Bool
+setNext c = do
+    n <- getPossible c
+    k <- getSize c
+    if k > 0
+        then do
+            findIncrement (k-1) (n-1) >>=
+                maybe (return False) (\(i,i') -> do
+                    unsafeSetElem c i (i'+1)
+                    setAscending k (i+1) (i'+2)
+                    return True
+                )
+        else 
+            return False
+  where
+    findIncrement i m = do
+        i' <- unsafeGetElem c i
+        if i' /= m then return (Just (i,i')) else recurse
+      where
+        recurse = if i /= 0 then findIncrement (i-1) (m-1) else return Nothing 
+
+    setAscending k i x | i == k = return ()
+                       | otherwise = do
+        unsafeSetElem c i x
+        setAscending k (i+1) (x+1)
+{-# INLINE setNext #-}
+        
+-- | Step backwards to the previous combination in lexicographic order and
+-- return @True@.  If there is no previous combination, return @False@ and
+-- leave the combination unmodified.
+setPrev :: (MChoose c m) => c -> m Bool
+setPrev c = do
+    n <- getPossible c
+    k <- getSize c
+    if k > 0
+        then do
+            k1' <- unsafeGetElem c (k-1)
+            findGap (k-1) k1' >>=
+                maybe (return False) (\(i,i') -> do
+                    unsafeSetElem c i (i'-1)
+                    setAscending k (i+1) (n-k+i+1)
+                    return True
+                )
+        else
+            return False
+  where
+    findGap i i' 
+        | i == 0 = 
+            if i' == 0 
+                then return $ Nothing
+                else return $ Just (0,i') 
+
+        | otherwise = let j = i-1 in do
+            j' <- unsafeGetElem c j
+            if i' /= j'+1 
+                then return $ Just (i,i')
+                else findGap j j' 
+
+
+    setAscending k i x | i == k = return ()
+                       | otherwise = do
+        unsafeSetElem c i x
+        setAscending k (i+1) (x+1)
+{-# INLINE setPrev #-}
+
+-- | Convert a mutable combination to an immutable one.
+freeze :: (MChoose c m) => c -> m Choose
+freeze c = unsafeFreeze =<< newCopyChoose c
+{-# INLINE freeze #-}
+
+-- | Convert an immutable combination to a mutable one.
+thaw :: (MChoose c m) => Choose -> m c
+thaw c = newCopyChoose =<< unsafeThaw c
+{-# INLINE thaw #-}
+
+
+--------------------------------- Instances ---------------------------------
+
+instance MChoose (STChoose s) (ST s) where
+    getPossible = getPossibleSTChoose
+    {-# INLINE getPossible #-}
+    getSize = getSizeSTChoose
+    {-# INLINE getSize #-}
+    newChoose = newSTChoose
+    {-# INLINE newChoose #-}
+    newChoose_ = newSTChoose_
+    {-# INLINE newChoose_ #-}
+    unsafeGetElem = unsafeGetElemSTChoose
+    {-# INLINE unsafeGetElem #-}
+    unsafeSetElem = unsafeSetElemSTChoose
+    {-# INLINE unsafeSetElem #-}
+    getElems = getElemsSTChoose
+    {-# INLINE getElems #-}
+    setElems = setElemsSTChoose
+    {-# INLINE setElems #-}
+    unsafeFreeze = unsafeFreezeSTChoose
+    {-# INLINE unsafeFreeze #-}
+    unsafeThaw = unsafeThawSTChoose
+    {-# INLINE unsafeThaw #-}
+
+instance MChoose IOChoose IO where
+    getPossible = getPossibleIOChoose
+    {-# INLINE getPossible #-}
+    getSize = getSizeIOChoose
+    {-# INLINE getSize #-}
+    newChoose = newIOChoose
+    {-# INLINE newChoose #-}
+    newChoose_ = newIOChoose_
+    {-# INLINE newChoose_ #-}
+    unsafeGetElem = unsafeGetElemIOChoose
+    {-# INLINE unsafeGetElem #-}
+    unsafeSetElem = unsafeSetElemIOChoose
+    {-# INLINE unsafeSetElem #-}
+    getElems = getElemsIOChoose
+    {-# INLINE getElems #-}
+    setElems = setElemsIOChoose
+    {-# INLINE setElems #-}
+    unsafeFreeze = unsafeFreezeIOChoose
+    {-# INLINE unsafeFreeze #-}
+    unsafeThaw = unsafeThawIOChoose
+    {-# INLINE unsafeThaw #-}
diff --git a/lib/Data/Choose/ST.hs b/lib/Data/Choose/ST.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Choose/ST.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE Rank2Types #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Data.Choose.ST
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+-- Mutable combinations in the 'ST' monad.
+
+module Data.Choose.ST (
+    -- * Combinations
+    STChoose,
+    runSTChoose,
+    
+    -- * Overloaded mutable combination interface
+    module Data.Choose.MChoose
+    ) where
+
+import Control.Monad.ST
+
+import Data.Choose.Base( Choose, STChoose, unsafeFreezeSTChoose )
+import Data.Choose.MChoose
+
+-- | A safe way to create and work with a mutable combination before returning 
+-- an immutable one for later perusal. This function avoids copying the 
+-- combination before returning it - it uses unsafeFreeze internally, but this 
+-- wrapper is a safe interface to that function. 
+runSTChoose :: (forall s. ST s (STChoose s)) -> Choose
+runSTChoose c = runST (c >>= unsafeFreezeSTChoose)
+{-# INLINE runSTChoose #-}
diff --git a/lib/Data/IntArray.hs b/lib/Data/IntArray.hs
--- a/lib/Data/IntArray.hs
+++ b/lib/Data/IntArray.hs
@@ -18,6 +18,7 @@
     elems,
 
     newArray_,
+    sameSTIntArray,
     
     numElementsSTIntArray,
     getNumElements,
@@ -70,6 +71,11 @@
         (# s2#, STIntArray n marr# #) }
   where
     sizeOfInt = case sizeOf (0 :: Int) of (I# s#) -> s#
+
+{-# INLINE sameSTIntArray #-}
+sameSTIntArray :: STIntArray s -> STIntArray s -> Bool
+sameSTIntArray (STIntArray _ marr1#) (STIntArray _ marr2#) =
+    sameMutableByteArray# marr1# marr2#
     
 {-# INLINE numElementsSTIntArray #-}
 numElementsSTIntArray :: STIntArray s -> Int
diff --git a/lib/Data/Permute.hs b/lib/Data/Permute.hs
--- a/lib/Data/Permute.hs
+++ b/lib/Data/Permute.hs
@@ -19,8 +19,8 @@
     swapsPermute,
 
     -- * Accessing permutation elements
-    apply,
-    unsafeApply,
+    at,
+    unsafeAt,
 
     -- * Permutation properties
     size,
@@ -56,7 +56,7 @@
     unsafeFreeze =<< newPermute n
 
 -- | Construct a permutation from a list of elements.  
--- @listPermute n is@ creates a permuation of size @n@ with
+-- @listPermute n is@ creates a permutation of size @n@ with
 -- the @i@th element equal to @is !! i@.  For the permutation to be valid,
 -- the list @is@ must have length @n@ and contain the indices @0..(n-1)@ 
 -- exactly once each.
@@ -65,7 +65,7 @@
     unsafeFreeze =<< newListPermute n is
 
 -- | Construct a permutation from a list of swaps.
--- @swapsPermute n ss@ creats a permuation of size @n@ given by a
+-- @swapsPermute n ss@ creats a permutation of size @n@ given by a
 -- sequence of swaps.
 -- If @ss@ is @[(i0,j0), (i1,j1), ..., (ik,jk)]@, the
 -- sequence of swaps is
@@ -76,16 +76,16 @@
 swapsPermute n ss = runST $
     unsafeFreeze =<< newSwapsPermute n ss
 
--- | @apply p i@ gets the value of the @i@th element of the permutation
+-- | @at p i@ gets the value of the @i@th element of the permutation
 -- @p@.  The index @i@ must be in the range @0..(n-1)@, where @n@ is the
 -- size of the permutation.
-apply :: Permute -> Int -> Int
-apply p i
+at :: Permute -> Int -> Int
+at p i
     | i >= 0 && i < size p = 
-        unsafeApply p i
+        unsafeAt p i
     | otherwise =
         error "Invalid index"
-{-# INLINE apply #-}
+{-# INLINE at #-}
 
 -- | Get the inverse of a permutation
 inverse :: Permute -> Permute
@@ -100,7 +100,7 @@
 next = nextPrevHelp setNext
 
 -- | Return the previous permutation in lexicographic order, or @Nothing@
--- if there is no such permutation.
+-- if no such permutation exists.
 prev :: Permute -> Maybe Permute
 prev = nextPrevHelp setPrev
 
diff --git a/lib/Data/Permute/Base.hs b/lib/Data/Permute/Base.hs
--- a/lib/Data/Permute/Base.hs
+++ b/lib/Data/Permute/Base.hs
@@ -27,13 +27,13 @@
 -- | The immutable permutation data type.
 -- Internally, a permutation of size @n@ is stored as an
 -- @0@-based array of @n@ 'Int's.  The permutation represents a reordering of
--- the integers @0, ..., (n-1)@.  The @i@th element of the array stores
--- the value @p[i]@. 
+-- the integers @0, ..., (n-1)@.  The permutation sents the value p[i] to 
+-- @i@. 
 newtype Permute = Permute IntArray
 
-unsafeApply :: Permute -> Int -> Int
-unsafeApply (Permute p) i = Arr.unsafeAt p i
-{-# INLINE unsafeApply #-}
+unsafeAt :: Permute -> Int -> Int
+unsafeAt (Permute p) i = Arr.unsafeAt p i
+{-# INLINE unsafeAt #-}
 
 -- | Get the size of the permutation.
 size :: Permute -> Int
@@ -70,7 +70,7 @@
 newSTPermute n = do
     p@(STPermute marr) <- newSTPermute_ n
     ArrST.writeElems marr [0 .. n-1]
-    return $! p
+    return p
 {-# INLINE newSTPermute #-}
 
 newSTPermute_ :: Int -> ST s (STPermute s)
@@ -108,3 +108,6 @@
 unsafeThawSTPermute (Permute arr) =
     (liftM STPermute . ArrST.unsafeThaw) arr
 {-# INLINE unsafeThawSTPermute #-}
+
+instance Eq (STPermute s) where
+    (==) (STPermute marr1) (STPermute marr2) = ArrST.sameSTIntArray marr1 marr2
diff --git a/lib/Data/Permute/IOBase.hs b/lib/Data/Permute/IOBase.hs
--- a/lib/Data/Permute/IOBase.hs
+++ b/lib/Data/Permute/IOBase.hs
@@ -15,9 +15,8 @@
 import Control.Monad.ST
 import Data.Permute.Base
 
--- | A mutable permutation that can be manipulated in the 'IO' monad. The
--- type argument @s@ is the state variable argument for the 'IO' type.
-newtype IOPermute = IOPermute (STPermute RealWorld)
+-- | A mutable permutation that can be manipulated in the 'IO' monad.
+newtype IOPermute = IOPermute (STPermute RealWorld) deriving Eq
 
 newIOPermute :: Int -> IO (IOPermute)
 newIOPermute n = liftM IOPermute $ stToIO (newSTPermute n)
diff --git a/lib/Data/Permute/MPermute.hs b/lib/Data/Permute/MPermute.hs
--- a/lib/Data/Permute/MPermute.hs
+++ b/lib/Data/Permute/MPermute.hs
@@ -112,7 +112,7 @@
     
         
 -- | Construct a permutation from a list of elements.  
--- @newListPermute n is@ creates a permuation of size @n@ with
+-- @newListPermute n is@ creates a permutation of size @n@ with
 -- the @i@th element equal to @is !! i@.  For the permutation to be valid,
 -- the list @is@ must have length @n@ and contain the indices @0..(n-1)@ 
 -- exactly once each.
@@ -121,18 +121,18 @@
     p <- unsafeNewListPermute n is
     valid <- isValid p
     when (not valid) $ fail "invalid permutation"
-    return $! p
+    return  p
 {-# INLINE newListPermute #-}
 
 unsafeNewListPermute :: (MPermute p m) => Int -> [Int] -> m p
 unsafeNewListPermute n is = do
     p <- newPermute_ n
     setElems p is
-    return $! p
+    return p
 {-# INLINE unsafeNewListPermute #-}
 
 -- | Construct a permutation from a list of swaps.
--- @newSwapsPermute n ss@ creates a permuation of size @n@ given a
+-- @newSwapsPermute n ss@ creates a permutation of size @n@ given a
 -- sequence of swaps.
 -- If @ss@ is @[(i0,j0), (i1,j1), ..., (ik,jk)]@, the
 -- sequence of swaps is
@@ -152,7 +152,7 @@
 newSwapsPermuteHelp swap n ss = do
     p <- newPermute n
     mapM_ (uncurry $ swap p) ss
-    return $! p
+    return p
 {-# INLINE newSwapsPermuteHelp #-}
 
 -- | Construct a new permutation by copying another.
@@ -161,11 +161,11 @@
     n  <- getSize p
     p' <- newPermute_ n
     copyPermute p' p
-    return $! p'
+    return p'
 {-# INLINE newCopyPermute #-}
 
 -- | @copyPermute dst src@ copies the elements of the permutation @src@
--- into the permtuation @dst@.  The two permutations must have the same
+-- into the permutation @dst@.  The two permutations must have the same
 -- size.
 copyPermute :: (MPermute p m) => p -> p -> m ()
 copyPermute dst src =
@@ -225,7 +225,7 @@
         i' <- unsafeGetElem p i
         valid  <- return $ i' >= 0 && i' < n
         unique <- liftM not (i' `existsIn` i)
-        return $! valid && unique
+        return $ valid && unique
 
     validIndices n = validIndicesHelp n 0
 
diff --git a/lib/Data/Permute/ST.hs b/lib/Data/Permute/ST.hs
--- a/lib/Data/Permute/ST.hs
+++ b/lib/Data/Permute/ST.hs
@@ -24,7 +24,7 @@
 import Data.Permute.MPermute
 
 -- | A safe way to create and work with a mutable permutation before returning 
--- an immutable permutation for later perusal. This function avoids copying the 
+-- an immutable one for later perusal. This function avoids copying the 
 -- permutation before returning it - it uses unsafeFreeze internally, but this 
 -- wrapper is a safe interface to that function. 
 runSTPermute :: (forall s. ST s (STPermute s)) -> Permute
diff --git a/permutation.cabal b/permutation.cabal
--- a/permutation.cabal
+++ b/permutation.cabal
@@ -1,17 +1,21 @@
 name:            permutation
-version:         0.2.1
+version:         0.3
 homepage:        http://stat.stanford.edu/~patperry/code/permutation
-synopsis:        A library for representing and applying permutations.
+synopsis:        A library for permutations and combinations.
 description:
-    This library includes data types for storing permutations.  It
-    implements pure and impure types, the latter of which can be modified
-    in-place.  The main utility of the library is converting between
-    the linear representation of a permutation and a sequence of swaps.
-    This allows, for instance, applying a permutation or its inverse
+    This library includes data types for storing permutations and
+    combinations.  It implements pure and impure types, the latter of
+    which can be modified in-place.  The library uses aggressive
+    inlining and MutableByteArray#s internally, so it is very
+    efficient.
+    .
+    The main utility of the library is converting between the linear
+    representation of a permutation and a sequence of swaps.  This 
+    allows, for instance, applying a permutation or its inverse
     to an array with O(1) memory use.
     .
     Much of the interface for the library is based on the permutation 
-    functions in the GNU Scientific Library (GSL).
+    and combination functions in the GNU Scientific Library (GSL).
     .
 category:        Data Structures, Math
 license:         BSD3
@@ -24,21 +28,30 @@
 tested-with:     GHC ==6.8.2, GHC ==6.10.1
 
 extra-source-files:  examples/Enumerate.hs
+                     tests/Test/Choose.hs
                      tests/Test/Permute.hs
                      tests/Driver.hs
                      tests/Main.hs
-                     tests/Pure.hs
-                     tests/ST.hs
+                     tests/Choose.hs
+                     tests/STChoose.hs
+                     tests/Permute.hs
+                     tests/STPermute.hs
                      tests/Makefile
 
 library
     hs-source-dirs:  lib
-    exposed-modules: Data.Permute
+    exposed-modules: Data.Choose
+                     Data.Choose.MChoose
+                     Data.Choose.IO
+                     Data.Choose.ST
+                     Data.Permute
                      Data.Permute.MPermute
                      Data.Permute.IO
                      Data.Permute.ST
                      
     other-modules:   Data.IntArray
+                     Data.Choose.Base
+                     Data.Choose.IOBase
                      Data.Permute.Base
                      Data.Permute.IOBase
 
diff --git a/tests/Choose.hs b/tests/Choose.hs
new file mode 100644
--- /dev/null
+++ b/tests/Choose.hs
@@ -0,0 +1,90 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Choose (
+    tests_Choose
+    ) where
+    
+import Control.Monad.ST
+import Data.Array.ST
+import Data.List( foldl' )
+import qualified Data.List as List
+import Data.Maybe( fromJust )
+
+import Data.Choose
+
+import Driver
+import Test.QuickCheck hiding (choose)
+    
+import Test.Choose()
+import qualified Test.Choose as Test
+
+
+prop_possible_choose (Index n' k) = let n = n'-1 in
+    possible (choose n k) == n
+prop_size_choose (Index n' k) = let n = n'-1 in
+    size (choose n k) == k
+prop_elems_choose (Index n' k) = let n = n'-1 in
+    elems (choose n k) == [0 .. k-1]
+
+prop_possible_listChoose (ListChoose n k is) =
+    possible (listChoose n k is) == n
+prop_size_listChoose (ListChoose n k is) =
+    size (listChoose n k is) == k
+prop_elems_listChoose (ListChoose n k is) =
+    elems (listChoose n k is) == is
+
+prop_at       = prop_at_help at
+prop_unsafeAt = prop_at_help unsafeAt
+prop_at_help a =
+    forAll arbitrary $ \(Index k i) ->
+    forAll arbitrary $ \(Nat nk) ->
+    forAll (Test.choose (nk+k) k) $ \c ->
+        a c i == (elems c) !! i
+
+prop_possible_complement (c :: Choose) =
+    possible (complement c) == possible c
+prop_size_complement (c :: Choose) =
+    size (complement c) == possible c - size c
+prop_elems_complement (c :: Choose) =
+    all (not . (`elem` is)) is'
+  where
+    is  = elems c
+    is' = elems (complement c)
+
+prop_prev_choose (Index n1 k) = let n = n1-1 in
+    prev (choose n k) == Nothing
+prop_next_last (Index n1 k) = let n = n1-1 in
+    next (listChoose n k $ [(n-k)..(n-1)]) == Nothing
+
+prop_next_prev (c :: Choose) =
+    case prev c of
+        Just c' -> c == (fromJust $ next c')
+        Nothing -> c == choose n k
+  where
+    n = possible c
+    k = size c
+    
+prop_prev_next (c :: Choose) =
+    case next c of
+        Just c' -> c == (fromJust $ prev c')
+        Nothing -> c == (listChoose n k $ [(n-k)..(n-1)])
+  where
+    n = possible c
+    k = size c
+
+tests_Choose = 
+    [ ("possible . choose"      , mytest prop_possible_choose)
+    , ("size . choose"          , mytest prop_size_choose)
+    , ("elems . choose"         , mytest prop_elems_choose)
+    , ("possible . listChoose"  , mytest prop_possible_listChoose)
+    , ("size . listChoose"      , mytest prop_size_listChoose)
+    , ("elems . listChoose"     , mytest prop_elems_listChoose)
+    , ("at"                     , mytest prop_at)
+    , ("unsafeAt"               , mytest prop_unsafeAt)
+    , ("possible . complement"  , mytest prop_possible_complement)
+    , ("size . complement"      , mytest prop_size_complement)
+    , ("elems . complement"     , mytest prop_elems_complement)
+    , ("prev . choose"          , mytest prop_prev_choose)
+    , ("next (last choose)"     , mytest prop_next_last)
+    , ("next . prev"            , mytest prop_next_prev)
+    , ("prev . next"            , mytest prop_prev_next)
+    ]
diff --git a/tests/Driver.hs b/tests/Driver.hs
--- a/tests/Driver.hs
+++ b/tests/Driver.hs
@@ -10,6 +10,7 @@
 module Driver (
     Natural(..),
     Index(..),
+    ListChoose(..),    
     ListPermute(..),
     SwapsPermute(..),
     Sort(..),
@@ -49,6 +50,19 @@
         return $ Index (n + 1) i
 
     coarbitrary = undefined
+
+data ListChoose = ListChoose Int Int [Int] deriving (Eq,Show)
+instance Arbitrary ListChoose where
+    arbitrary = do
+        (Nat n) <- arbitrary
+        k <- choose (0,n)
+        
+        xs <- vector n :: Gen [Int]
+        return . ListChoose n k $ 
+            sort $ take k $ (snd . unzip) $ sortBy (comparing fst) $ zip xs [0..]
+
+    coarbitrary = undefined
+
 
 data ListPermute = ListPermute Int [Int] deriving (Eq,Show)
 instance Arbitrary ListPermute where
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -4,8 +4,10 @@
 import Text.Printf
 
 import Driver
-import Pure
-import ST
+import Choose
+import Permute
+import STChoose
+import STPermute
 
 main :: IO ()
 main = do
@@ -36,9 +38,12 @@
     when (not . and $ smokeResults ++ results) $ fail "\nNot all tests passed!"
  where
 
-    smoke = [ ("STPermute", smoke_STPermute) 
+    smoke = [ ("STChoose" , smoke_STChoose) 
+            , ("STPermute", smoke_STPermute) 
             ]
 
-    tests = [ ("Permute"   , tests_Permute)
+    tests = [ ("STChoose"  , tests_Choose)
+            , ("STChoose"  , tests_STChoose)
+            , ("Permute"   , tests_Permute)
             , ("STPermute" , tests_STPermute)
             ]
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -1,16 +1,17 @@
 all:
-	ghc -O -i. -i../lib Main.hs --make -o test-permute
-	./test-permute
+	ghc -O -i. -i../lib Main.hs --make -o test-permutation
+	./test-permutation
 
 hpc:
-	ghc -fforce-recomp -i. -i../lib -fhpc --make Main.hs -o test-permute
-	rm -f test-permute.tix
-	./test-permute
-	hpc markup test-permute
+	ghc -fforce-recomp -i. -i../lib -fhpc --make Main.hs -o test-permutation
+	rm -f test-permutation.tix
+	./test-permutation
+	hpc markup test-permutation
 
 clean:
 	find ../lib . -name '*.hi' | xargs rm -f
 	find ../lib . -name '*.o'  | xargs rm -f
 	find . -name '*.html' | xargs rm -f
-	rm -f test-permute test-permute.tix
+	rm -f test-permutation test-permutation.tix
+	rm -rf .hpc
 	
diff --git a/tests/Permute.hs b/tests/Permute.hs
new file mode 100644
--- /dev/null
+++ b/tests/Permute.hs
@@ -0,0 +1,173 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Permute (
+    tests_Permute
+    ) where
+    
+import Control.Monad.ST
+import Data.Array.ST
+import Data.List( foldl' )
+import qualified Data.List as List
+import Data.Maybe( fromJust )
+
+import Data.Permute
+
+import Driver
+import Test.QuickCheck
+    
+import Test.Permute()
+import qualified Test.Permute as Test
+
+
+prop_size_permute (Nat n) =
+    size (permute n) == n
+prop_elems_permute (Nat n) =
+    elems (permute n) == [0..(n-1)]
+
+prop_size_listPermute (ListPermute n is) =
+    size (listPermute n is) == n
+prop_elems_listPermute (ListPermute n is) =
+    elems (listPermute n is) == is
+
+prop_size_swapsPermute (SwapsPermute n ss) =
+    size (swapsPermute n ss) == n
+prop_elems_swapsPermute (SwapsPermute n ss) =
+    elems (swapsPermute n ss) == map at [0..(n-1)]
+  where
+    at i = foldl' doSwap i $ reverse ss
+    doSwap k (i,j) | k == i    = j
+                   | k == j    = i
+                   | otherwise = k
+
+prop_at       = prop_at_help at
+prop_unsafeAt = prop_at_help unsafeAt
+prop_at_help a =
+    forAll arbitrary $ \(Index n i) ->
+    forAll (Test.permute n) $ \p ->
+        a p i == (elems p) !! i
+
+prop_size_inverse (p :: Permute) =
+    size (inverse p) == size p
+prop_elems_inverse (p :: Permute) =
+    all (\i -> is' !! (at p i) == i) [0..(n-1)]
+  where
+    n   = size p
+    is' = elems (inverse p)
+
+prop_swaps (Nat n) =
+    forAll (Test.permute n) $ \p ->
+    forAll (vector n) $ \xs ->
+        let xs' = applySwaps (swaps p) xs
+        in all (\i -> xs' !! i == xs !! (at p i)) [0..(n-1)]
+
+prop_invSwaps (Nat n) =
+    forAll (Test.permute n) $ \p ->
+    forAll (vector n) $ \xs ->
+        let xs' = applySwaps (invSwaps p) xs
+        in all (\i -> xs' !! (at p i) == xs !! i) [0..(n-1)]
+
+prop_swaps_inverse (Nat n) =
+    forAll (Test.permute n) $ \p ->
+    forAll (vector n) $ \xs ->
+        applySwaps (swaps $ inverse p) xs == (applySwaps (invSwaps p) xs)
+    
+prop_invSwaps_inverse (Nat n) =
+    forAll (Test.permute n) $ \p ->
+    forAll (vector n) $ \xs ->
+        applySwaps (invSwaps $ inverse p) xs == (applySwaps (swaps p) xs)
+
+prop_prev_permute (Nat n) =
+    prev (permute n) == Nothing
+prop_next_last (Nat n) =
+    next (listPermute n $ reverse [0..(n-1)]) == Nothing
+
+prop_next_prev (p :: Permute) =
+    case prev p of
+        Just p' -> p == (fromJust $ next p')
+        Nothing -> p == permute n
+  where
+    n = size p
+    
+prop_prev_next (p :: Permute) =
+    case next p of
+        Just p' -> p == (fromJust $ prev p')
+        Nothing -> p == (listPermute n $ reverse [0..(n-1)])
+  where
+    n = size p
+
+prop_fst_sort (Sort n xs) = let
+    ys = take n xs
+    in (fst . sort n) xs == (List.sort ys)
+prop_snd_sort (Sort n xs) = let
+    ys = take n xs
+    in applySwaps (swaps $ snd $ sort n xs) ys == (List.sort ys)
+
+prop_fst_sortBy (SortBy cmp n xs) = let 
+    ys = take n xs
+    in (fst . sortBy cmp n) xs == (List.sortBy cmp ys)
+prop_snd_sortBy (SortBy cmp n xs) = let 
+    ys = take n xs
+    in applySwaps (swaps $ snd $ sortBy cmp n xs) ys == (List.sortBy cmp ys)
+
+prop_order (Sort n xs) = let 
+    ys = take n xs
+    in applySwaps (swaps $ order n xs) ys == (List.sort ys)
+
+prop_orderBy (SortBy cmp n xs) = let 
+    ys = take n xs
+    in applySwaps (swaps $ orderBy cmp n xs) ys == (List.sortBy cmp ys)
+
+prop_rank (Sort n xs) = let
+    ys = take n xs
+    in applySwaps (invSwaps $ rank n xs) ys == (List.sort ys)
+
+prop_rankBy (SortBy cmp n xs) = let
+    ys = take n xs
+    in applySwaps (invSwaps $ rankBy cmp n xs) ys == (List.sortBy cmp ys)
+
+prop_swapsPermute_swaps (p :: Permute) =
+    swapsPermute (size p) (swaps p) == p
+
+
+tests_Permute = 
+    [ ("size . permute"          , mytest prop_size_permute)
+    , ("elems . permute"         , mytest prop_elems_permute)
+    , ("size . listPermute"      , mytest prop_size_listPermute)
+    , ("elems . listPermute"     , mytest prop_elems_listPermute)
+    , ("size . swapsPermute"     , mytest prop_size_swapsPermute)
+    , ("elems . swapsPermute"    , mytest prop_elems_swapsPermute)
+    , ("at"                      , mytest prop_at)
+    , ("unsafeAt"                , mytest prop_unsafeAt)
+    , ("size . inverse"          , mytest prop_size_inverse)
+    , ("elems . inverse"         , mytest prop_elems_inverse)
+    , ("swaps"                   , mytest prop_swaps)
+    , ("invSwaps"                , mytest prop_invSwaps)
+    , ("swaps . inverse"         , mytest prop_swaps_inverse)
+    , ("invSwaps . inverse"      , mytest prop_invSwaps_inverse)
+    , ("prev . permute"          , mytest prop_prev_permute)
+    , ("next (last permutation)" , mytest prop_next_last)
+    , ("next . prev"             , mytest prop_next_prev)
+    , ("prev . next"             , mytest prop_prev_next)
+    , ("fst . sort"              , mytest prop_fst_sort)
+    , ("snd . sort"              , mytest prop_snd_sort)
+    , ("fst . sortBy"            , mytest prop_fst_sortBy)
+    , ("snd . sortBy"            , mytest prop_snd_sortBy)
+    , ("order"                   , mytest prop_order)
+    , ("orderBy"                 , mytest prop_orderBy)
+    , ("rank"                    , mytest prop_rank)
+    , ("rankBy"                  , mytest prop_rankBy)
+    , ("swapsPermute . swaps"    , mytest prop_swapsPermute_swaps)
+    ]
+
+
+applySwaps :: [(Int,Int)] -> [Int] -> [Int]
+applySwaps ss xs = runST $ do
+    arr <- newListArray (0,length xs - 1) xs :: ST s (STUArray s Int Int) 
+    mapM_ (swap arr) ss
+    getElems arr
+  where
+    swap arr (i,j) = do
+        i' <- readArray arr i
+        j' <- readArray arr j
+        writeArray arr j i'
+        writeArray arr i j'
+
diff --git a/tests/Pure.hs b/tests/Pure.hs
deleted file mode 100644
--- a/tests/Pure.hs
+++ /dev/null
@@ -1,173 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-module Pure (
-    tests_Permute
-    ) where
-    
-import Control.Monad.ST
-import Data.Array.ST
-import Data.List( foldl' )
-import qualified Data.List as List
-import Data.Maybe( fromJust )
-
-import Data.Permute
-
-import Driver
-import Test.QuickCheck
-    
-import Test.Permute()
-import qualified Test.Permute as Test
-
-
-prop_size_permute (Nat n) =
-    size (permute n) == n
-prop_elems_permute (Nat n) =
-    elems (permute n) == [0..(n-1)]
-
-prop_size_listPermute (ListPermute n is) =
-    size (listPermute n is) == n
-prop_elems_listPermute (ListPermute n is) =
-    elems (listPermute n is) == is
-
-prop_size_swapsPermute (SwapsPermute n ss) =
-    size (swapsPermute n ss) == n
-prop_elems_swapsPermute (SwapsPermute n ss) =
-    elems (swapsPermute n ss) == map at [0..(n-1)]
-  where
-    at i = foldl' doSwap i $ reverse ss
-    doSwap k (i,j) | k == i    = j
-                   | k == j    = i
-                   | otherwise = k
-
-prop_apply       = prop_apply_help apply
-prop_unsafeApply = prop_apply_help unsafeApply
-prop_apply_help a =
-    forAll arbitrary $ \(Index n i) ->
-    forAll (Test.permute n) $ \p ->
-        a p i == (elems p) !! i
-
-prop_size_inverse (p :: Permute) =
-    size (inverse p) == size p
-prop_elems_inverse (p :: Permute) =
-    all (\i -> is' !! (apply p i) == i) [0..(n-1)]
-  where
-    n   = size p
-    is' = elems (inverse p)
-
-prop_swaps (Nat n) =
-    forAll (Test.permute n) $ \p ->
-    forAll (vector n) $ \xs ->
-        let xs' = applySwaps (swaps p) xs
-        in all (\i -> xs' !! i == xs !! (apply p i)) [0..(n-1)]
-
-prop_invSwaps (Nat n) =
-    forAll (Test.permute n) $ \p ->
-    forAll (vector n) $ \xs ->
-        let xs' = applySwaps (invSwaps p) xs
-        in all (\i -> xs' !! (apply p i) == xs !! i) [0..(n-1)]
-
-prop_swaps_inverse (Nat n) =
-    forAll (Test.permute n) $ \p ->
-    forAll (vector n) $ \xs ->
-        applySwaps (swaps $ inverse p) xs == (applySwaps (invSwaps p) xs)
-    
-prop_invSwaps_inverse (Nat n) =
-    forAll (Test.permute n) $ \p ->
-    forAll (vector n) $ \xs ->
-        applySwaps (invSwaps $ inverse p) xs == (applySwaps (swaps p) xs)
-
-prop_prev_permute (Nat n) =
-    prev (permute n) == Nothing
-prop_next_last (Nat n) =
-    next (listPermute n $ reverse [0..(n-1)]) == Nothing
-
-prop_next_prev (p :: Permute) =
-    case prev p of
-        Just p' -> p == (fromJust $ next p')
-        Nothing -> p == permute n
-  where
-    n = size p
-    
-prop_prev_next (p :: Permute) =
-    case next p of
-        Just p' -> p == (fromJust $ prev p')
-        Nothing -> p == (listPermute n $ reverse [0..(n-1)])
-  where
-    n = size p
-
-prop_fst_sort (Sort n xs) = let
-    ys = take n xs
-    in (fst . sort n) xs == (List.sort ys)
-prop_snd_sort (Sort n xs) = let
-    ys = take n xs
-    in applySwaps (swaps $ snd $ sort n xs) ys == (List.sort ys)
-
-prop_fst_sortBy (SortBy cmp n xs) = let 
-    ys = take n xs
-    in (fst . sortBy cmp n) xs == (List.sortBy cmp ys)
-prop_snd_sortBy (SortBy cmp n xs) = let 
-    ys = take n xs
-    in applySwaps (swaps $ snd $ sortBy cmp n xs) ys == (List.sortBy cmp ys)
-
-prop_order (Sort n xs) = let 
-    ys = take n xs
-    in applySwaps (swaps $ order n xs) ys == (List.sort ys)
-
-prop_orderBy (SortBy cmp n xs) = let 
-    ys = take n xs
-    in applySwaps (swaps $ orderBy cmp n xs) ys == (List.sortBy cmp ys)
-
-prop_rank (Sort n xs) = let
-    ys = take n xs
-    in applySwaps (invSwaps $ rank n xs) ys == (List.sort ys)
-
-prop_rankBy (SortBy cmp n xs) = let
-    ys = take n xs
-    in applySwaps (invSwaps $ rankBy cmp n xs) ys == (List.sortBy cmp ys)
-
-prop_swapsPermute_swaps (p :: Permute) =
-    swapsPermute (size p) (swaps p) == p
-
-
-tests_Permute = 
-    [ ("size . permute"          , mytest prop_size_permute)
-    , ("elems . permute"         , mytest prop_elems_permute)
-    , ("size . listPermute"      , mytest prop_size_listPermute)
-    , ("elems . listPermute"     , mytest prop_elems_listPermute)
-    , ("size . swapsPermute"     , mytest prop_size_swapsPermute)
-    , ("elems . swapsPermute"    , mytest prop_elems_swapsPermute)
-    , ("apply"                   , mytest prop_apply)
-    , ("unsafeApply"             , mytest prop_unsafeApply)
-    , ("size . inverse"          , mytest prop_size_inverse)
-    , ("elems . inverse"         , mytest prop_elems_inverse)
-    , ("swaps"                   , mytest prop_swaps)
-    , ("invSwaps"                , mytest prop_invSwaps)
-    , ("swaps . inverse"         , mytest prop_swaps_inverse)
-    , ("invSwaps . inverse"      , mytest prop_invSwaps_inverse)
-    , ("prev . permute"          , mytest prop_prev_permute)
-    , ("next (last permutation)" , mytest prop_next_last)
-    , ("next . prev"             , mytest prop_next_prev)
-    , ("prev . next"             , mytest prop_prev_next)
-    , ("fst . sort"              , mytest prop_fst_sort)
-    , ("snd . sort"              , mytest prop_snd_sort)
-    , ("fst . sortBy"            , mytest prop_fst_sortBy)
-    , ("snd . sortBy"            , mytest prop_snd_sortBy)
-    , ("order"                   , mytest prop_order)
-    , ("orderBy"                 , mytest prop_orderBy)
-    , ("rank"                    , mytest prop_rank)
-    , ("rankBy"                  , mytest prop_rankBy)
-    , ("swapsPermute . swaps"    , mytest prop_swapsPermute_swaps)
-    ]
-
-
-applySwaps :: [(Int,Int)] -> [Int] -> [Int]
-applySwaps ss xs = runST $ do
-    arr <- newListArray (0,length xs - 1) xs :: ST s (STUArray s Int Int) 
-    mapM_ (swap arr) ss
-    getElems arr
-  where
-    swap arr (i,j) = do
-        i' <- readArray arr i
-        j' <- readArray arr j
-        writeArray arr j i'
-        writeArray arr i j'
-
diff --git a/tests/ST.hs b/tests/ST.hs
deleted file mode 100644
--- a/tests/ST.hs
+++ /dev/null
@@ -1,231 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-module ST (
-    tests_STPermute,
-    smoke_STPermute
-    ) where
-    
-import Control.Monad
-import Control.Monad.ST
-
-import Data.Permute
-import Data.Permute.ST
-
-
-import Driver
-import Debug.Trace
-import Test.QuickCheck
-import Text.Printf
-    
-import Test.Permute()
-import qualified Test.Permute as Test
-
-newPermute_S n = permute n
-prop_NewPermute (Nat n) = 
-    newPermute n `equivalent` newPermute_S n
-
-newListPermute_S n is = listPermute n is
-prop_NewListPermute (ListPermute n is) =
-    newListPermute n is `equivalent` newListPermute_S n is
-
-newSwapsPermute_S n ss = swapsPermute n ss
-prop_NewSwapsPermute (SwapsPermute n ss) =
-    newSwapsPermute n ss `equivalent` newSwapsPermute_S n ss
-prop_UnsafeNewSwapsPermute (SwapsPermute n ss) =
-    unsafeNewSwapsPermute n ss `equivalent` newSwapsPermute_S n ss
-
-
-
-newCopyPermute_S p = (p, p)
-prop_NewCopyPermute =
-    implements
-        (\p -> newCopyPermute p >>= unsafeFreeze)
-        (\p -> newCopyPermute_S p)
-
-copyPermute_S p q = ((), q, q)
-prop_CopyPermute =
-    copyPermute `implements2` copyPermute_S
-
-setIdentity_S p = ((), permute (size p))
-prop_SetIdentity =
-    setIdentity `implements` setIdentity_S 
-
-getElem_S p i = ((elems p) !! i, p)
-prop_GetElem (Index n i) =
-    implementsFor n
-        (\p -> getElem   p i)
-        (\p -> getElem_S p i)
-
-prop_UnsafeGetElem (Index n i) =
-    implementsFor n
-        (\p -> unsafeGetElem p i)
-        (\p -> getElem_S p i)
-
-swapElems_S p i j = ((), p')
-  where
-    (n,is) = (size p, elems p)
-      
-    at k | k == i    = is !! j
-         | k == j    = is !! i
-         | otherwise = is !! k
-    p'   = listPermute n $ map at [0..(n-1)]
-
-prop_SwapElems (Swap n i j) =
-    implementsFor n
-        (\p -> swapElems p i j) 
-        (\p -> swapElems_S p i j)
-
-prop_UnsafeSwapElems (Swap n i j) =
-    implementsFor n
-        (\p -> unsafeSwapElems p i j) 
-        (\p -> swapElems_S p i j)
-
-
-getSize_S p = (length (elems p), p)
-prop_GetSize = getSize `implements` getSize_S
-      
-getElems_S p = (elems p, p)
-prop_GetElems = getElems `implements` getElems_S
-
-prop_IsValid_Strict = runST $ do
-    p <- newPermute 10
-    setElem p 0 1
-    valid <- isValid p
-    setElem p 0 0
-    return $ valid == False
-
-prop_GetSwaps_Lazy1 = runST $ do
-    p <- newPermute 10
-    ss <- getSwaps p
-    swapElems p 0 1
-    return $ length ss == 1
-
-prop_GetSwaps_Lazy2 = runST $ do
-    p <- newPermute 10
-    ss <- getSwaps p
-    swapElems p 0 1
-    swapElems p 3 4
-    head ss `seq` swapElems p 3 4
-    return $ length ss == 1
-
-tests_STPermute = 
-    [ ("newPermute"               , mytest prop_NewPermute)
-    , ("newListPermute"           , mytest prop_NewListPermute)
-    , ("newSwapsPermute"          , mytest prop_NewSwapsPermute)
-    , ("unsafeNewSwapsPermute"    , mytest prop_UnsafeNewSwapsPermute)
-    , ("newCopyPermute"           , mytest prop_NewCopyPermute)
-    , ("copyPermute"              , mytest prop_CopyPermute)
-    , ("setIdentity"              , mytest prop_SetIdentity)
-    , ("getElem"                  , mytest prop_GetElem)
-    , ("unsafeGetElem"            , mytest prop_UnsafeGetElem)
-    , ("swapElems"                , mytest prop_SwapElems)
-    , ("unsafeSwapElems"          , mytest prop_UnsafeSwapElems)
-    , ("getSize"                  , mytest prop_GetSize)
-    , ("getElems"                 , mytest prop_GetElems)
-    ]
-
-smoke_STPermute =
-    [ ("isValid is strict"             , mytest prop_IsValid_Strict)
-    , ("getSwaps is lazy (test 1)"     , mytest prop_GetSwaps_Lazy1)
-    , ("getSwaps is lazy (test 2)"     , mytest prop_GetSwaps_Lazy2)
-    ]
-
-------------------------------------------------------------------------
--- 
--- The specification language
---
-    
-abstract :: STPermute s -> ST s Permute
-abstract = freeze
-
-commutes :: (Eq a, Show a) =>
-    STPermute s -> (STPermute s -> ST s a) ->
-        (Permute -> (a,Permute)) -> ST s Bool
-commutes p a f = do
-    old <- abstract p
-    r   <- a p
-    new <- abstract p
-    let s      = f old
-        s'     = (r,new)
-        passed = s == s'
-        
-    when (not passed) $
-        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
-              return ()
-              
-    return passed
-
-equivalent :: (forall s . ST s (STPermute s)) -> Permute -> Bool
-equivalent p s = runST $ do
-    p' <- (p >>= abstract)
-    when (not $ p' == s) $
-        trace (printf ("expected `%s' but got `%s'") (show s) (show p'))
-            return ()
-    return (p' == s)
-    
-implements :: (Eq a, Show a) =>
-    (forall s . STPermute s -> ST s a) ->
-    (Permute -> (a,Permute)) -> 
-        Property
-a `implements` f =
-    forAll arbitrary $ \(Nat n) ->
-        implementsFor n a f
-
-implementsFor :: (Eq a, Show a) =>
-    Int ->
-    (forall s . STPermute s -> ST s a) ->
-    (Permute -> (a,Permute)) -> 
-        Property
-implementsFor n a f =
-    forAll (Test.permute n) $ \p ->
-        runST $ do
-            p' <- unsafeThaw p
-            commutes p' a f
-
-implementsIf :: (Eq a, Show a) =>
-    (forall s . STPermute s -> ST s Bool) ->
-    (forall s . STPermute s -> ST s a) ->
-    (Permute -> (a, Permute)) -> 
-        Property
-implementsIf pre a f =
-    forAll arbitrary $ \p ->
-        runST ( do
-            p' <- thaw p
-            pre p') ==>
-        runST ( do
-            p' <- unsafeThaw p
-            commutes p' a f )
-
-
-commutes2 :: (Eq a, Show a) =>
-    STPermute s -> STPermute s -> (STPermute s -> STPermute s -> ST s a) ->
-        (Permute -> Permute -> (a,Permute,Permute)) -> ST s Bool
-commutes2 p q a f = do
-    oldp <- abstract p
-    oldq <- abstract q
-    r   <- a p q
-    newp <- abstract p
-    newq <- abstract q
-    let s      = f oldp oldq
-        s'     = (r,newp,newq)
-        passed = s == s'
-        
-    when (not passed) $
-        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
-              return ()
-              
-    return passed
-
-
-implements2 :: (Eq a, Show a) =>
-    (forall s . STPermute s -> STPermute s -> ST s a) ->
-    (Permute -> Permute -> (a,Permute,Permute)) -> 
-        Property
-implements2 a f =
-    forAll arbitrary $ \(Nat n) ->
-    forAll (Test.permute n) $ \p ->
-    forAll (Test.permute n) $ \q ->
-        runST $ do
-            p' <- unsafeThaw p
-            q' <- unsafeThaw q
-            commutes2 p' q' a f
-
diff --git a/tests/STChoose.hs b/tests/STChoose.hs
new file mode 100644
--- /dev/null
+++ b/tests/STChoose.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE Rank2Types #-}
+module STChoose (
+    tests_STChoose,
+    smoke_STChoose
+    ) where
+    
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Choose
+import Data.Choose.ST
+
+
+import Driver
+import Debug.Trace
+import Test.QuickCheck hiding ( choose )
+import qualified Test.QuickCheck as QC
+import Text.Printf
+    
+import Test.Choose()
+import qualified Test.Choose as Test
+
+newChoose_S n k = choose n k
+prop_NewChoose (Index n k) = let n' = n-1 in
+    newChoose n' k `equivalent` newChoose_S n' k
+
+newListChoose_S n k is = listChoose n k is
+prop_NewListChoose (ListChoose n k is) =
+    newListChoose n k is `equivalent` newListChoose_S n k is
+
+newCopyChoose_S c = (c, c)
+prop_NewCopyChoose =
+    implements
+        (\c -> newCopyChoose c >>= unsafeFreeze)
+        (\c -> newCopyChoose_S c)
+
+copyChoose_S dst src = ((), src, src)
+prop_CopyChoose =
+    copyChoose `implements2` copyChoose_S
+
+setFirst_S c = ((), choose (possible c) (size c))
+prop_SetFirst =
+    setFirst `implements` setFirst_S 
+
+getElem_S c i = (c `at` i, c)
+prop_GetElem (Index k i) =
+    forAll arbitrary $ \(Nat n) ->
+    implementsFor (n+k) k
+        (\c -> getElem   c i)
+        (\c -> getElem_S c i)
+
+prop_UnsafeGetElem (Index k i) =
+    forAll arbitrary $ \(Nat n) ->    
+    implementsFor (n+k) k
+        (\c -> unsafeGetElem c i)
+        (\c -> getElem_S c i)
+
+getPossible_S c = (possible c, c)
+prop_GetPossible = getPossible `implements` getPossible_S
+
+getSize_S c = (length (elems c), c)
+prop_GetSize = getSize `implements` getSize_S
+      
+getElems_S c = (elems c, c)
+prop_GetElems = getElems `implements` getElems_S
+
+prop_IsValid_Strict = runST $ do
+    c <- newChoose 10 3
+    setElem c 0 1
+    valid <- isValid c
+    setElem c 0 0
+    return $ valid == False
+
+tests_STChoose = 
+    [ ("newChoose"               , mytest prop_NewChoose)
+    , ("newListChoose"           , mytest prop_NewListChoose)
+    , ("newCopyChoose"           , mytest prop_NewCopyChoose)
+    , ("setFirst"                , mytest prop_SetFirst)
+    , ("getElem"                 , mytest prop_GetElem)
+    , ("unsafeGetElem"           , mytest prop_UnsafeGetElem)
+    , ("getPossible"             , mytest prop_GetPossible)
+    , ("getSize"                 , mytest prop_GetSize)
+    , ("getElems"                , mytest prop_GetElems)
+    ]
+
+smoke_STChoose =
+    [ ("isValid is strict"             , mytest prop_IsValid_Strict)
+    ]
+
+------------------------------------------------------------------------
+-- 
+-- The specification language
+--
+    
+abstract :: STChoose s -> ST s Choose
+abstract = freeze
+
+commutes :: (Eq a, Show a) =>
+    STChoose s -> (STChoose s -> ST s a) ->
+        (Choose -> (a,Choose)) -> ST s Bool
+commutes c a f = do
+    old <- abstract c
+    r   <- a c
+    new <- abstract c
+    let s      = f old
+        s'     = (r,new)
+        passed = s == s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+equivalent :: (forall s . ST s (STChoose s)) -> Choose -> Bool
+equivalent c s = runST $ do
+    c' <- (c >>= abstract)
+    when (not $ c' == s) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show c'))
+            return ()
+    return (c' == s)
+    
+implements :: (Eq a, Show a) =>
+    (forall s . STChoose s -> ST s a) ->
+    (Choose -> (a,Choose)) -> 
+        Property
+a `implements` f =
+    forAll arbitrary $ \(Nat n) ->
+    forAll (QC.choose (0,n)) $ \k ->
+        implementsFor n k a f
+
+implementsFor :: (Eq a, Show a) =>
+    Int -> Int ->
+    (forall s . STChoose s -> ST s a) ->
+    (Choose -> (a,Choose)) -> 
+        Property
+implementsFor n k a f =
+    forAll (Test.choose n k) $ \c ->
+        runST $ do
+            c' <- unsafeThaw c
+            commutes c' a f
+
+implementsIf :: (Eq a, Show a) =>
+    (forall s . STChoose s -> ST s Bool) ->
+    (forall s . STChoose s -> ST s a) ->
+    (Choose -> (a, Choose)) -> 
+        Property
+implementsIf pre a f =
+    forAll arbitrary $ \c ->
+        runST ( do
+            c' <- thaw c
+            pre c') ==>
+        runST ( do
+            c' <- unsafeThaw c
+            commutes c' a f )
+
+commutes2 :: (Eq a, Show a) =>
+    STChoose s -> STChoose s -> (STChoose s -> STChoose s -> ST s a) ->
+        (Choose -> Choose -> (a,Choose,Choose)) -> ST s Bool
+commutes2 c1 c2 a f = do
+    oldc1 <- abstract c1
+    oldc2 <- abstract c2
+    r   <- a c1 c2
+    newc1 <- abstract c1
+    newc2 <- abstract c2
+    let s      = f oldc1 oldc2
+        s'     = (r,newc1,newc2)
+        passed = s == s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+implements2 :: (Eq a, Show a) =>
+    (forall s . STChoose s -> STChoose s -> ST s a) ->
+    (Choose -> Choose -> (a,Choose,Choose)) -> 
+        Property
+implements2 a f =
+    forAll arbitrary $ \(Nat n) ->
+    forAll (QC.choose (0,n)) $ \k ->
+    forAll (Test.choose n k) $ \c1 ->
+    forAll (Test.choose n k) $ \c2 ->
+        runST $ do
+            c1' <- unsafeThaw c1
+            c2' <- unsafeThaw c2
+            commutes2 c1' c2' a f
+
diff --git a/tests/STPermute.hs b/tests/STPermute.hs
new file mode 100644
--- /dev/null
+++ b/tests/STPermute.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE Rank2Types #-}
+module STPermute (
+    tests_STPermute,
+    smoke_STPermute
+    ) where
+    
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Permute
+import Data.Permute.ST
+
+
+import Driver
+import Debug.Trace
+import Test.QuickCheck
+import Text.Printf
+    
+import Test.Permute()
+import qualified Test.Permute as Test
+
+newPermute_S n = permute n
+prop_NewPermute (Nat n) = 
+    newPermute n `equivalent` newPermute_S n
+
+newListPermute_S n is = listPermute n is
+prop_NewListPermute (ListPermute n is) =
+    newListPermute n is `equivalent` newListPermute_S n is
+
+newSwapsPermute_S n ss = swapsPermute n ss
+prop_NewSwapsPermute (SwapsPermute n ss) =
+    newSwapsPermute n ss `equivalent` newSwapsPermute_S n ss
+prop_UnsafeNewSwapsPermute (SwapsPermute n ss) =
+    unsafeNewSwapsPermute n ss `equivalent` newSwapsPermute_S n ss
+
+
+
+newCopyPermute_S p = (p, p)
+prop_NewCopyPermute =
+    implements
+        (\p -> newCopyPermute p >>= unsafeFreeze)
+        (\p -> newCopyPermute_S p)
+
+copyPermute_S p q = ((), q, q)
+prop_CopyPermute =
+    copyPermute `implements2` copyPermute_S
+
+setIdentity_S p = ((), permute (size p))
+prop_SetIdentity =
+    setIdentity `implements` setIdentity_S 
+
+getElem_S p i = ((elems p) !! i, p)
+prop_GetElem (Index n i) =
+    implementsFor n
+        (\p -> getElem   p i)
+        (\p -> getElem_S p i)
+
+prop_UnsafeGetElem (Index n i) =
+    implementsFor n
+        (\p -> unsafeGetElem p i)
+        (\p -> getElem_S p i)
+
+swapElems_S p i j = ((), p')
+  where
+    (n,is) = (size p, elems p)
+      
+    at k | k == i    = is !! j
+         | k == j    = is !! i
+         | otherwise = is !! k
+    p'   = listPermute n $ map at [0..(n-1)]
+
+prop_SwapElems (Swap n i j) =
+    implementsFor n
+        (\p -> swapElems p i j) 
+        (\p -> swapElems_S p i j)
+
+prop_UnsafeSwapElems (Swap n i j) =
+    implementsFor n
+        (\p -> unsafeSwapElems p i j) 
+        (\p -> swapElems_S p i j)
+
+
+getSize_S p = (length (elems p), p)
+prop_GetSize = getSize `implements` getSize_S
+      
+getElems_S p = (elems p, p)
+prop_GetElems = getElems `implements` getElems_S
+
+prop_IsValid_Strict = runST $ do
+    p <- newPermute 10
+    setElem p 0 1
+    valid <- isValid p
+    setElem p 0 0
+    return $ valid == False
+
+prop_GetSwaps_Lazy1 = runST $ do
+    p <- newPermute 10
+    ss <- getSwaps p
+    swapElems p 0 1
+    return $ length ss == 1
+
+prop_GetSwaps_Lazy2 = runST $ do
+    p <- newPermute 10
+    ss <- getSwaps p
+    swapElems p 0 1
+    swapElems p 3 4
+    head ss `seq` swapElems p 3 4
+    return $ length ss == 1
+
+tests_STPermute = 
+    [ ("newPermute"               , mytest prop_NewPermute)
+    , ("newListPermute"           , mytest prop_NewListPermute)
+    , ("newSwapsPermute"          , mytest prop_NewSwapsPermute)
+    , ("unsafeNewSwapsPermute"    , mytest prop_UnsafeNewSwapsPermute)
+    , ("newCopyPermute"           , mytest prop_NewCopyPermute)
+    , ("copyPermute"              , mytest prop_CopyPermute)
+    , ("setIdentity"              , mytest prop_SetIdentity)
+    , ("getElem"                  , mytest prop_GetElem)
+    , ("unsafeGetElem"            , mytest prop_UnsafeGetElem)
+    , ("swapElems"                , mytest prop_SwapElems)
+    , ("unsafeSwapElems"          , mytest prop_UnsafeSwapElems)
+    , ("getSize"                  , mytest prop_GetSize)
+    , ("getElems"                 , mytest prop_GetElems)
+    ]
+
+smoke_STPermute =
+    [ ("isValid is strict"             , mytest prop_IsValid_Strict)
+    , ("getSwaps is lazy (test 1)"     , mytest prop_GetSwaps_Lazy1)
+    , ("getSwaps is lazy (test 2)"     , mytest prop_GetSwaps_Lazy2)
+    ]
+
+------------------------------------------------------------------------
+-- 
+-- The specification language
+--
+    
+abstract :: STPermute s -> ST s Permute
+abstract = freeze
+
+commutes :: (Eq a, Show a) =>
+    STPermute s -> (STPermute s -> ST s a) ->
+        (Permute -> (a,Permute)) -> ST s Bool
+commutes p a f = do
+    old <- abstract p
+    r   <- a p
+    new <- abstract p
+    let s      = f old
+        s'     = (r,new)
+        passed = s == s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+equivalent :: (forall s . ST s (STPermute s)) -> Permute -> Bool
+equivalent p s = runST $ do
+    p' <- (p >>= abstract)
+    when (not $ p' == s) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show p'))
+            return ()
+    return (p' == s)
+    
+implements :: (Eq a, Show a) =>
+    (forall s . STPermute s -> ST s a) ->
+    (Permute -> (a,Permute)) -> 
+        Property
+a `implements` f =
+    forAll arbitrary $ \(Nat n) ->
+        implementsFor n a f
+
+implementsFor :: (Eq a, Show a) =>
+    Int ->
+    (forall s . STPermute s -> ST s a) ->
+    (Permute -> (a,Permute)) -> 
+        Property
+implementsFor n a f =
+    forAll (Test.permute n) $ \p ->
+        runST $ do
+            p' <- unsafeThaw p
+            commutes p' a f
+
+implementsIf :: (Eq a, Show a) =>
+    (forall s . STPermute s -> ST s Bool) ->
+    (forall s . STPermute s -> ST s a) ->
+    (Permute -> (a, Permute)) -> 
+        Property
+implementsIf pre a f =
+    forAll arbitrary $ \p ->
+        runST ( do
+            p' <- thaw p
+            pre p') ==>
+        runST ( do
+            p' <- unsafeThaw p
+            commutes p' a f )
+
+
+commutes2 :: (Eq a, Show a) =>
+    STPermute s -> STPermute s -> (STPermute s -> STPermute s -> ST s a) ->
+        (Permute -> Permute -> (a,Permute,Permute)) -> ST s Bool
+commutes2 p q a f = do
+    oldp <- abstract p
+    oldq <- abstract q
+    r   <- a p q
+    newp <- abstract p
+    newq <- abstract q
+    let s      = f oldp oldq
+        s'     = (r,newp,newq)
+        passed = s == s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+
+implements2 :: (Eq a, Show a) =>
+    (forall s . STPermute s -> STPermute s -> ST s a) ->
+    (Permute -> Permute -> (a,Permute,Permute)) -> 
+        Property
+implements2 a f =
+    forAll arbitrary $ \(Nat n) ->
+    forAll (Test.permute n) $ \p ->
+    forAll (Test.permute n) $ \q ->
+        runST $ do
+            p' <- unsafeThaw p
+            q' <- unsafeThaw q
+            commutes2 p' q' a f
+
diff --git a/tests/Test/Choose.hs b/tests/Test/Choose.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Choose.hs
@@ -0,0 +1,39 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Test.Choose
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- License    : BSD3
+-- Maintainer : Patrick Perry <patperry@stanford.edu>
+-- Stability  : experimental
+--
+
+module Test.Choose (
+    choose
+    ) where
+
+import Control.Monad( liftM )
+import Data.Ord( comparing )
+import Data.List( sort, sortBy )
+import Test.QuickCheck hiding ( choose )
+import qualified Test.QuickCheck as QC
+import Data.Choose( Choose )
+import qualified Data.Choose as C
+
+-- | @choose n k@ generates a random combination of @k@ outcomes
+-- from @n@ possibilities.
+choose :: Int -> Int -> Gen Choose
+choose n k = do
+    xs <- vector n :: Gen [Int]
+    let is = (snd . unzip) $ sortBy (comparing fst) $ zip xs [0..]
+    return $ C.listChoose n k $ sort $ take k is
+
+instance Arbitrary Choose where
+    arbitrary = do
+        n <- liftM abs arbitrary
+        k <- QC.choose (0,n)
+        c <- choose n k
+        return c
+        
+    coarbitrary c =
+        coarbitrary $ (C.possible c, C.size c, C.elems c)