diff --git a/library/PrimitiveExtras/Bitmap.hs b/library/PrimitiveExtras/Bitmap.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/Bitmap.hs
@@ -0,0 +1,114 @@
+module PrimitiveExtras.Bitmap
+(
+  Bitmap,
+  empty,
+  singleton,
+  insert,
+  invert,
+  indexList,
+  boolList,
+  pair,
+  populatedIndex,
+  isPopulated,
+  population,
+  null,
+  bits,
+  populatedIndicesList,
+  int,
+  allBitsList,
+  allBitsUnfold,
+  populatedBitsUnfold,
+  indicesAmongstPopulatedBitsUnfold,
+)
+where
+
+import PrimitiveExtras.Prelude hiding (traverse_, insert, null, empty)
+import PrimitiveExtras.Types
+import qualified DeferredFolds.Unfold as Unfold
+
+
+{-# NOINLINE maxSize #-}
+maxSize :: Int
+maxSize = finiteBitSize (undefined :: Int)
+
+{-# NOINLINE maxBit #-}
+maxBit :: Int
+maxBit = pred maxSize
+
+{-# NOINLINE allBitsList #-}
+allBitsList :: [Int]
+allBitsList = [0 .. maxBit]
+
+-- * Constructors
+-------------------------
+
+{-# INLINE empty #-}
+empty :: Bitmap
+empty = Bitmap 0
+
+{-# INLINE singleton #-}
+singleton :: Int -> Bitmap
+singleton = Bitmap . bit
+
+{-# INLINE insert #-}
+insert :: Int -> Bitmap -> Bitmap
+insert i = Bitmap . (bit i .|.) . int
+
+{-# INLINE invert #-}
+invert :: Int -> Bitmap -> Bitmap
+invert i = Bitmap . (bit i `xor`) . int
+
+{-# INLINE indexList #-}
+indexList :: [Int] -> Bitmap
+indexList = Bitmap . foldr (.|.) 0 . map bit
+
+{-# INLINE boolList #-}
+boolList :: [Bool] -> Bitmap
+boolList = Bitmap . foldr (.|.) 0 . zipWith (\ index -> bool 0 (bit index)) allBitsList
+
+{-# INLINE pair #-}
+pair :: Int -> Int -> Bitmap
+pair i1 i2 = Bitmap (bit i1 .|. bit i2)
+
+-- * Accessors
+-------------------------
+
+-- |
+-- A number of non-zero bits, preceding this one.
+{-# INLINE populatedIndex #-}
+populatedIndex :: Int -> Bitmap -> Int
+populatedIndex i (Bitmap int) = popCount (int .&. (bit i - 1))
+
+{-# INLINE isPopulated #-}
+isPopulated :: Int -> Bitmap -> Bool
+isPopulated index (Bitmap int) = testBit int index
+
+{-# INLINE population #-}
+population :: Bitmap -> Int
+population (Bitmap int) = popCount int
+
+{-# INLINE null #-}
+null :: Bitmap -> Bool
+null (Bitmap int) = int == 0
+
+{-# INLINE bits #-}
+bits :: Bitmap -> [Int]
+bits (Bitmap int) = filter (testBit int) allBitsList
+
+{-# INLINE populatedIndicesList #-}
+populatedIndicesList :: Bitmap -> [Int]
+populatedIndicesList = enumFromTo 0 . pred . population
+
+{-# INLINE int #-}
+int :: Bitmap -> Int
+int (Bitmap int) = int
+
+{-# NOINLINE allBitsUnfold #-}
+allBitsUnfold :: Unfold Int
+allBitsUnfold = Unfold.intsInRange 0 maxBit
+
+populatedBitsUnfold :: Bitmap -> Unfold Int
+populatedBitsUnfold bitmap = Unfold.filter (flip isPopulated bitmap) allBitsUnfold
+
+indicesAmongstPopulatedBitsUnfold :: Bitmap -> Unfold Int
+indicesAmongstPopulatedBitsUnfold bitmap = Unfold.intsInRange 0 (pred (population bitmap))
diff --git a/library/PrimitiveExtras/Cereal/Get.hs b/library/PrimitiveExtras/Cereal/Get.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Cereal/Get.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module PrimitiveExtras.Cereal.Get
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import Data.Serialize.Get
-import PrimitiveExtras.Monad
-
-
-primArray :: Prim element => Get element -> Get (PrimArray element)
-primArray element =
-  do
-    size <- fromIntegral <$> getInt64le
-    replicateMPrimArray size element
-
-primMultiArray :: Prim element => Get element -> Get (PrimMultiArray element)
-primMultiArray element =
-  do
-    size <- fromIntegral <$> getInt64le
-    replicateMMultiPrimArray size (primArray element)
diff --git a/library/PrimitiveExtras/Cereal/Put.hs b/library/PrimitiveExtras/Cereal/Put.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Cereal/Put.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module PrimitiveExtras.Cereal.Put
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import Data.Serialize.Put
-import qualified PrimitiveExtras.Monad as Monad
-
-
-primArray :: Prim element => Putter element -> Putter (PrimArray element)
-primArray element primArrayValue =
-  size <> elements
-  where
-    size = putInt64le (fromIntegral (sizeofPrimArray primArrayValue))
-    elements = traversePrimArray_ element primArrayValue
-
-primMultiArray :: Prim element => Putter element -> Putter (PrimMultiArray element)
-primMultiArray element (PrimMultiArray outerArrayValue) =
-  size <> innerArrays
-  where
-    size = putInt64le (fromIntegral (sizeofUnliftedArray outerArrayValue))
-    innerArrays = Monad.traverseUnliftedArray_ (primArray element) outerArrayValue
diff --git a/library/PrimitiveExtras/Data.hs b/library/PrimitiveExtras/Data.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Data.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module PrimitiveExtras.Data
-(
-  PrimMultiArray,
-  TVarArray,
-)
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import PrimitiveExtras.Instances
diff --git a/library/PrimitiveExtras/Fold.hs b/library/PrimitiveExtras/Fold.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Fold.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-module PrimitiveExtras.Fold
-(
-  indexCounts,
-  unliftedArray,
-  primMultiArray,
-)
-where
-
-import PrimitiveExtras.Prelude hiding (fold, foldM)
-import PrimitiveExtras.Types
-import Control.Foldl
-import qualified PrimitiveExtras.UnliftedArray as UA
-
-
-unsafeIO :: (state -> input -> IO state) -> IO state -> (state -> IO output) -> Fold input output
-unsafeIO stepInIO initInIO extractInIO =
-  Fold
-    (\ !state input -> unsafeDupablePerformIO (stepInIO state input))
-    (unsafeDupablePerformIO initInIO)
-    (\ state -> let !output = unsafePerformIO (extractInIO state) in output)
-
-foldMInUnsafeDupableIO :: FoldM IO input output -> Fold input output
-foldMInUnsafeDupableIO (FoldM step init extract) = unsafeIO step init extract
-
-{-|
-Given a size of the array,
-construct a fold, which produces an array of index counts.
--}
-indexCounts :: (Integral count, Prim count) => Int {-^ Array size -} -> Fold Int (PrimArray count)
-indexCounts size = unsafeIO step init extract where
-  init = unsafeThawPrimArray (replicatePrimArray size 0)
-  step mutable i = do
-    count <- readPrimArray mutable i
-    writePrimArray mutable i (succ count)
-    return mutable
-  extract = unsafeFreezePrimArray
-
-{-|
-This function is partial in the sense that it expects the
-index vector of produced elements to be within the specified amount.
--}
-unliftedArray :: PrimUnlifted element => Int {-^ Size of the array -} -> Fold (Int, element) (UnliftedArray element)
-unliftedArray size =
-  unsafeIO step init extract
-  where
-    step mutable (index, element) =
-      writeUnliftedArray mutable index element $> mutable
-    init =
-      unsafeNewUnliftedArray size
-    extract =
-      unsafeFreezeUnliftedArray
-
-{-|
-Having a priorly computed array of inner dimension sizes,
-e.g., using the 'indexCounts' fold,
-construct a fold over indexed elements into a multi-array of elements.
-
-Thus it allows to construct it in two passes over the indexed elements.
--}
-primMultiArray :: forall size element. (Integral size, Prim size, Prim element) => PrimArray size -> Fold (Int, element) (PrimMultiArray element)
-primMultiArray sizeArray =
-  unsafeIO step init extract
-  where
-    outerLength = sizeofPrimArray sizeArray
-    init =
-      Product2 <$> initIndexArray <*> initMultiArray
-      where
-        initIndexArray :: IO (MutablePrimArray RealWorld size)
-        initIndexArray =
-          unsafeThawPrimArray (replicatePrimArray outerLength 0)
-        initMultiArray :: IO (UnliftedArray (MutablePrimArray RealWorld element))
-        initMultiArray =
-          UA.generate outerLength $ \ index -> do
-            newPrimArray (fromIntegral (indexPrimArray sizeArray index))
-    step (Product2 indexArray multiArray) (outerIndex, element) = do
-      innerArray <- indexUnliftedArrayM multiArray outerIndex
-      innerIndex <- readPrimArray indexArray outerIndex
-      writePrimArray indexArray outerIndex (succ innerIndex)
-      writePrimArray innerArray (fromIntegral innerIndex) element
-      return (Product2 indexArray multiArray)
-    extract (Product2 _ multiArray) = do
-      copied <- unsafeNewUnliftedArray outerLength
-      forMFromZero_ outerLength $ \ outerIndex -> do
-        let mutableInnerArray = indexUnliftedArray multiArray outerIndex
-        frozenInnerArray <- unsafeFreezePrimArray mutableInnerArray
-        writeUnliftedArray copied outerIndex frozenInnerArray
-      result <- unsafeFreezeUnliftedArray copied
-      return $ PrimMultiArray $ result
diff --git a/library/PrimitiveExtras/Folds.hs b/library/PrimitiveExtras/Folds.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/Folds.hs
@@ -0,0 +1,88 @@
+module PrimitiveExtras.Folds
+(
+  indexCounts,
+  unliftedArray,
+  primMultiArray,
+)
+where
+
+import PrimitiveExtras.Prelude hiding (fold, foldM)
+import PrimitiveExtras.Types
+import Control.Foldl
+import qualified PrimitiveExtras.UnliftedArray as UA
+
+
+unsafeIO :: (state -> input -> IO state) -> IO state -> (state -> IO output) -> Fold input output
+unsafeIO stepInIO initInIO extractInIO =
+  Fold
+    (\ !state input -> unsafeDupablePerformIO (stepInIO state input))
+    (unsafeDupablePerformIO initInIO)
+    (\ state -> let !output = unsafePerformIO (extractInIO state) in output)
+
+foldMInUnsafeDupableIO :: FoldM IO input output -> Fold input output
+foldMInUnsafeDupableIO (FoldM step init extract) = unsafeIO step init extract
+
+{-|
+Given a size of the array,
+construct a fold, which produces an array of index counts.
+-}
+indexCounts :: (Integral count, Prim count) => Int {-^ Array size -} -> Fold Int (PrimArray count)
+indexCounts size = unsafeIO step init extract where
+  init = unsafeThawPrimArray (replicatePrimArray size 0)
+  step mutable i = do
+    count <- readPrimArray mutable i
+    writePrimArray mutable i (succ count)
+    return mutable
+  extract = unsafeFreezePrimArray
+
+{-|
+This function is partial in the sense that it expects the
+index vector of produced elements to be within the specified amount.
+-}
+unliftedArray :: PrimUnlifted element => Int {-^ Size of the array -} -> Fold (Int, element) (UnliftedArray element)
+unliftedArray size =
+  unsafeIO step init extract
+  where
+    step mutable (index, element) =
+      writeUnliftedArray mutable index element $> mutable
+    init =
+      unsafeNewUnliftedArray size
+    extract =
+      unsafeFreezeUnliftedArray
+
+{-|
+Having a priorly computed array of inner dimension sizes,
+e.g., using the 'indexCounts' fold,
+construct a fold over indexed elements into a multi-array of elements.
+
+Thus it allows to construct it in two passes over the indexed elements.
+-}
+primMultiArray :: forall size element. (Integral size, Prim size, Prim element) => PrimArray size -> Fold (Int, element) (PrimMultiArray element)
+primMultiArray sizeArray =
+  unsafeIO step init extract
+  where
+    outerLength = sizeofPrimArray sizeArray
+    init =
+      Product2 <$> initIndexArray <*> initMultiArray
+      where
+        initIndexArray :: IO (MutablePrimArray RealWorld size)
+        initIndexArray =
+          unsafeThawPrimArray (replicatePrimArray outerLength 0)
+        initMultiArray :: IO (UnliftedArray (MutablePrimArray RealWorld element))
+        initMultiArray =
+          UA.generate outerLength $ \ index -> do
+            newPrimArray (fromIntegral (indexPrimArray sizeArray index))
+    step (Product2 indexArray multiArray) (outerIndex, element) = do
+      innerArray <- indexUnliftedArrayM multiArray outerIndex
+      innerIndex <- readPrimArray indexArray outerIndex
+      writePrimArray indexArray outerIndex (succ innerIndex)
+      writePrimArray innerArray (fromIntegral innerIndex) element
+      return (Product2 indexArray multiArray)
+    extract (Product2 _ multiArray) = do
+      copied <- unsafeNewUnliftedArray outerLength
+      forMFromZero_ outerLength $ \ outerIndex -> do
+        let mutableInnerArray = indexUnliftedArray multiArray outerIndex
+        frozenInnerArray <- unsafeFreezePrimArray mutableInnerArray
+        writeUnliftedArray copied outerIndex frozenInnerArray
+      result <- unsafeFreezeUnliftedArray copied
+      return $ PrimMultiArray $ result
diff --git a/library/PrimitiveExtras/IO.hs b/library/PrimitiveExtras/IO.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/IO.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-module PrimitiveExtras.IO
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import qualified PrimitiveExtras.UnliftedArray as A
-
-
--- * UnliftedArray
--------------------------
-
-generateUnliftedArray :: PrimUnlifted a => Int -> (Int -> IO a) -> IO (UnliftedArray a)
-generateUnliftedArray = A.generate
-
-replicateUnliftedArray :: PrimUnlifted a => Int -> IO a -> IO (UnliftedArray a)
-replicateUnliftedArray = A.replicateIO
-
--- * Array
--------------------------
-
-generateArray :: Int -> (Int -> IO a) -> IO (Array a)
-generateArray size elementIO =
-  do
-    array <- newArray size undefined
-    let
-      loop index =
-        if index < size
-          then do
-            element <- elementIO index
-            writeArray array index element
-            loop (succ index)
-          else unsafeFreezeArray array
-      in loop 0
-
-replicateArray :: Int -> IO a -> IO (Array a)
-replicateArray size elementIO =
-  do
-    array <- newArray size undefined
-    let
-      loop index =
-        if index < size
-          then do
-            element <- elementIO
-            writeArray array index element
-            loop (succ index)
-          else unsafeFreezeArray array
-      in loop 0
-
--- * PrimArray
--------------------------
-
-generatePrimArray :: Prim a => Int -> (Int -> IO a) -> IO (PrimArray a)
-generatePrimArray size elementIO =
-  do
-    array <- newPrimArray size
-    let
-      loop index =
-        if index < size
-          then do
-            element <- elementIO index
-            writePrimArray array index element
-            loop (succ index)
-          else unsafeFreezePrimArray array
-      in loop 0
-
-replicatePrimArray :: Prim a => Int -> IO a -> IO (PrimArray a)
-replicatePrimArray size elementIO =
-  do
-    array <- newPrimArray size
-    let
-      loop index =
-        if index < size
-          then do
-            element <- elementIO
-            writePrimArray array index element
-            loop (succ index)
-          else unsafeFreezePrimArray array
-      in loop 0
-
-traversePrimArrayWithIndexInRange :: Prim a => PrimArray a -> Int -> Int -> (Int -> a -> IO ()) -> IO ()
-traversePrimArrayWithIndexInRange primArray from to action =
-  let iterate index = if index < to
-        then do
-          action index $! indexPrimArray primArray index
-          iterate (succ index)
-        else return ()
-      in iterate from
-
--- * TVarArray
--------------------------
-
-newTVarArray :: a -> Int -> IO (TVarArray a)
-newTVarArray a size = TVarArray <$> replicateUnliftedArray size (newTVarIO a)
-
-freezeTVarArrayAsPrimArray :: Prim a => TVarArray a -> IO (PrimArray a)
-freezeTVarArrayAsPrimArray (TVarArray varArray) =
-  do
-    let size = sizeofUnliftedArray varArray
-    mpa <- newPrimArray size
-    forMFromZero_ size $ \ index -> do
-      var <- indexUnliftedArrayM varArray index
-      value <- atomically (readTVar var)
-      writePrimArray mpa index value
-    unsafeFreezePrimArray mpa
-
-modifyTVarArrayAt :: TVarArray a -> Int -> (a -> a) -> IO ()
-modifyTVarArrayAt (TVarArray array) index fn =
-  do
-    var <- indexUnliftedArrayM array index
-    atomically $ modifyTVar' var fn
diff --git a/library/PrimitiveExtras/Instances.hs b/library/PrimitiveExtras/Instances.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Instances.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module PrimitiveExtras.Instances
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-
-deriving instance (Eq a, Prim a) => Eq (PrimMultiArray a)
-
-deriving instance (Ord a, Prim a) => Ord (PrimMultiArray a)
-
-instance (Show a, Prim a) => Show (PrimMultiArray a) where
-  show (PrimMultiArray outerArray) =
-    unliftedArrayToList outerArray &
-    map primArrayToList &
-    show
diff --git a/library/PrimitiveExtras/Monad.hs b/library/PrimitiveExtras/Monad.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Monad.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module PrimitiveExtras.Monad
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import qualified PrimitiveExtras.Fold as A
-
-
-{-| Given a size of the outer array and a function, which executes a fold over indexed elements in a monad,
-constructs a prim multi-array -}
-primMultiArray :: (Monad m, Prim element) => Int -> (forall x. Fold (Int, element) x -> m x) -> m (PrimMultiArray element)
-primMultiArray outerArraySize runFold =
-  do
-    indexCounts <- runFold (lmap fst (A.indexCounts outerArraySize))
-    runFold (A.primMultiArray (indexCounts :: PrimArray Word32))
-
-replicateMMultiPrimArray :: (Monad m, Prim a) => Int -> m (PrimArray a) -> m (PrimMultiArray a)
-replicateMMultiPrimArray size elementM =
-  do
-    !mutable <- return (unsafeDupablePerformIO (unsafeNewUnliftedArray size))
-    let 
-      iterate index =
-        if index < size
-          then do
-            element <- elementM
-            let !() = unsafeDupablePerformIO (writeUnliftedArray mutable index element)
-            iterate (succ index)
-          else return (PrimMultiArray (unsafePerformIO (unsafeFreezeUnliftedArray mutable)))
-      in iterate 0
-
-{-| Please notice that this function is highly untested -}
-replicateMPrimArray :: (Monad m, Prim element) => Int -> m element -> m (PrimArray element)
-replicateMPrimArray size elementM =
-  do
-    !mutable <- return (unsafeDupablePerformIO (newPrimArray size))
-    let 
-      iterate index =
-        if index < size
-          then do
-            element <- elementM
-            let !() = unsafeDupablePerformIO (writePrimArray mutable index element)
-            iterate (succ index)
-          else return (unsafePerformIO (unsafeFreezePrimArray mutable))
-      in iterate 0
-
-traverseUnliftedArray_ :: (Monad m, PrimUnlifted a) => (a -> m ()) -> UnliftedArray a -> m ()
-traverseUnliftedArray_ action array =
-  let
-    size = sizeofUnliftedArray array
-    iterate index = if index < size
-      then do
-        element <- indexUnliftedArrayM array index
-        action element
-        iterate (succ index)
-      else return ()
-    in iterate 0
diff --git a/library/PrimitiveExtras/Prelude.hs b/library/PrimitiveExtras/Prelude.hs
--- a/library/PrimitiveExtras/Prelude.hs
+++ b/library/PrimitiveExtras/Prelude.hs
@@ -31,6 +31,7 @@
 import Data.Foldable as Exports
 import Data.Function as Exports hiding (id, (.))
 import Data.Functor as Exports
+import Data.Functor.Identity as Exports
 import Data.Int as Exports
 import Data.IORef as Exports
 import Data.Ix as Exports
@@ -91,6 +92,10 @@
 -------------------------
 import Data.Primitive as Exports
 import Control.Monad.Primitive as Exports
+
+-- focus
+-------------------------
+import Focus as Exports (Focus(..))
 
 
 data Product2 a b = Product2 !a !b
diff --git a/library/PrimitiveExtras/PrimArray.hs b/library/PrimitiveExtras/PrimArray.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/PrimArray.hs
@@ -0,0 +1,101 @@
+module PrimitiveExtras.PrimArray
+where
+
+import PrimitiveExtras.Prelude hiding (replicateM, traverse_)
+import PrimitiveExtras.Types
+import qualified Data.Serialize as Cereal
+import qualified Data.Vector.Unboxed as UnboxedVector
+import qualified Data.Vector.Primitive as PrimitiveVector
+
+
+oneHot :: Prim a => Int {-^ Size -} -> Int {-^ Index -} -> a -> PrimArray a
+oneHot size index value =
+  runST $ do
+    marr <- newPrimArray size
+    writePrimArray marr index value
+    unsafeFreezePrimArray marr
+
+generate :: Prim a => Int -> (Int -> IO a) -> IO (PrimArray a)
+generate size elementIO =
+  do
+    array <- newPrimArray size
+    let
+      loop index =
+        if index < size
+          then do
+            element <- elementIO index
+            writePrimArray array index element
+            loop (succ index)
+          else unsafeFreezePrimArray array
+      in loop 0
+
+replicate :: Prim a => Int -> IO a -> IO (PrimArray a)
+replicate size elementIO =
+  do
+    array <- newPrimArray size
+    let
+      loop index =
+        if index < size
+          then do
+            element <- elementIO
+            writePrimArray array index element
+            loop (succ index)
+          else unsafeFreezePrimArray array
+      in loop 0
+
+{-| Please notice that this function is highly untested -}
+replicateM :: (Monad m, Prim element) => Int -> m element -> m (PrimArray element)
+replicateM size elementM =
+  do
+    !mutable <- return (unsafeDupablePerformIO (newPrimArray size))
+    let 
+      iterate index =
+        if index < size
+          then do
+            element <- elementM
+            let !() = unsafeDupablePerformIO (writePrimArray mutable index element)
+            iterate (succ index)
+          else return (unsafePerformIO (unsafeFreezePrimArray mutable))
+      in iterate 0
+
+traverse_ = traversePrimArray_
+
+traverseWithIndexInRange_ :: Prim a => PrimArray a -> Int -> Int -> (Int -> a -> IO ()) -> IO ()
+traverseWithIndexInRange_ primArray from to action =
+  let iterate index = if index < to
+        then do
+          action index $! indexPrimArray primArray index
+          iterate (succ index)
+        else return ()
+      in iterate from
+
+toElementsUnfold :: Prim prim => PrimArray prim -> Unfold prim
+toElementsUnfold ba = Unfold $ \f z -> foldlPrimArray' f z ba
+
+toElementsUnfoldM :: (Monad m, Prim prim) => PrimArray prim -> UnfoldM m prim
+toElementsUnfoldM ba = UnfoldM $ \f z -> foldlPrimArrayM' f z ba
+
+toByteArray :: PrimArray a -> ByteArray
+toByteArray (PrimArray unliftedByteArray) =
+  ByteArray unliftedByteArray
+
+toPrimitiveVector :: Prim a => PrimArray a -> PrimitiveVector.Vector a
+toPrimitiveVector primArray =
+  PrimitiveVector.Vector 0 (sizeofPrimArray primArray) (toByteArray primArray)
+
+toUnboxedVector :: Prim a => PrimArray a -> UnboxedVector.Vector a
+toUnboxedVector primArray =
+  unsafeCoerce (toPrimitiveVector primArray)
+
+cerealGet :: Prim element => Cereal.Get element -> Cereal.Get (PrimArray element)
+cerealGet element =
+  do
+    size <- fromIntegral <$> Cereal.getInt64le
+    replicateM size element
+
+cerealPut :: Prim element => Cereal.Putter element -> Cereal.Putter (PrimArray element)
+cerealPut element primArrayValue =
+  size <> elements
+  where
+    size = Cereal.putInt64le (fromIntegral (sizeofPrimArray primArrayValue))
+    elements = traverse_ element primArrayValue
diff --git a/library/PrimitiveExtras/PrimMultiArray.hs b/library/PrimitiveExtras/PrimMultiArray.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/PrimMultiArray.hs
@@ -0,0 +1,97 @@
+module PrimitiveExtras.PrimMultiArray
+(
+  PrimMultiArray,
+  create,
+  replicateM,
+  outerLength,
+  toAssocsUnfold,
+  toIndicesUnfold,
+  toUnfoldAt,
+  toAssocsUnfoldM,
+  toIndicesUnfoldM,
+  toUnfoldAtM,
+  cerealGet,
+  cerealPut,
+)
+where
+
+import PrimitiveExtras.Prelude hiding (replicateM)
+import PrimitiveExtras.Types
+import qualified DeferredFolds.Unfold as Unfold
+import qualified DeferredFolds.UnfoldM as UnfoldM
+import qualified PrimitiveExtras.UnliftedArray as UnliftedArray
+import qualified PrimitiveExtras.PrimArray as PrimArray
+import qualified PrimitiveExtras.Folds as Folds
+import qualified Data.Serialize as Cereal
+
+
+deriving instance (Eq a, Prim a) => Eq (PrimMultiArray a)
+
+deriving instance (Ord a, Prim a) => Ord (PrimMultiArray a)
+
+instance (Show a, Prim a) => Show (PrimMultiArray a) where
+  show (PrimMultiArray outerArray) =
+    unliftedArrayToList outerArray &
+    map primArrayToList &
+    show
+
+{-| Given a size of the outer array and a function, which executes a fold over indexed elements in a monad,
+constructs a prim multi-array -}
+create :: (Monad m, Prim element) => Int -> (forall x. Fold (Int, element) x -> m x) -> m (PrimMultiArray element)
+create outerArraySize runFold =
+  do
+    indexCounts <- runFold (lmap fst (Folds.indexCounts outerArraySize))
+    runFold (Folds.primMultiArray (indexCounts :: PrimArray Word32))
+
+replicateM :: (Monad m, Prim a) => Int -> m (PrimArray a) -> m (PrimMultiArray a)
+replicateM size elementM =
+  do
+    !mutable <- return (unsafeDupablePerformIO (unsafeNewUnliftedArray size))
+    let 
+      iterate index =
+        if index < size
+          then do
+            element <- elementM
+            let !() = unsafeDupablePerformIO (writeUnliftedArray mutable index element)
+            iterate (succ index)
+          else return (PrimMultiArray (unsafePerformIO (unsafeFreezeUnliftedArray mutable)))
+      in iterate 0
+
+{-| Get length of the outer dimension of a primitive multi array -}
+outerLength :: PrimMultiArray a -> Int
+outerLength (PrimMultiArray outerDimension) = sizeofUnliftedArray outerDimension
+
+toAssocsUnfold :: Prim a => PrimMultiArray a -> Unfold (Int, a)
+toAssocsUnfold = Unfold.unfoldM . toAssocsUnfoldM
+
+toIndicesUnfold :: PrimMultiArray a -> Unfold Int
+toIndicesUnfold (PrimMultiArray ua) = Unfold.intsInRange 0 (pred (sizeofUnliftedArray ua))
+
+toUnfoldAt :: Prim prim => PrimMultiArray prim -> Int -> Unfold prim
+toUnfoldAt (PrimMultiArray ua) index = UnliftedArray.at ua index empty PrimArray.toElementsUnfold
+
+toAssocsUnfoldM :: (Monad m, Prim a) => PrimMultiArray a -> UnfoldM m (Int, a)
+toAssocsUnfoldM pma =
+  do
+    index <- toIndicesUnfoldM pma
+    element <- toUnfoldAtM pma index
+    return (index, element)
+
+toIndicesUnfoldM :: Monad m => PrimMultiArray a -> UnfoldM m Int
+toIndicesUnfoldM (PrimMultiArray ua) = UnfoldM.intsInRange 0 (pred (sizeofUnliftedArray ua))
+
+toUnfoldAtM :: (Monad m, Prim prim) => PrimMultiArray prim -> Int -> UnfoldM m prim
+toUnfoldAtM (PrimMultiArray ua) index = UnliftedArray.at ua index empty PrimArray.toElementsUnfoldM
+
+cerealGet :: Prim element => Cereal.Get element -> Cereal.Get (PrimMultiArray element)
+cerealGet element =
+  do
+    size <- fromIntegral <$> Cereal.getInt64le
+    replicateM size (PrimArray.cerealGet element)
+
+cerealPut :: Prim element => Cereal.Putter element -> Cereal.Putter (PrimMultiArray element)
+cerealPut element (PrimMultiArray outerArrayValue) =
+  size <> innerArrays
+  where
+    size = Cereal.putInt64le (fromIntegral (sizeofUnliftedArray outerArrayValue))
+    innerArrays = UnliftedArray.traverse_ (PrimArray.cerealPut element) outerArrayValue
diff --git a/library/PrimitiveExtras/Pure.hs b/library/PrimitiveExtras/Pure.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Pure.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module PrimitiveExtras.Pure
-where
-
-import PrimitiveExtras.Prelude
-import PrimitiveExtras.Types
-import qualified Data.Vector.Unboxed as A
-import qualified Data.Vector.Primitive as B
-
-
-{-| Get length of the outer dimension of a primitive multi array -}
-primMultiArrayOuterLength :: PrimMultiArray a -> Int
-primMultiArrayOuterLength (PrimMultiArray outerDimension) = sizeofUnliftedArray outerDimension
-
-oneHotPrimArray :: Prim a => Int {-^ Size -} -> Int {-^ Index -} -> a -> PrimArray a
-oneHotPrimArray size index value =
-  runST $ do
-    marr <- newPrimArray size
-    writePrimArray marr index value
-    unsafeFreezePrimArray marr
-
-primArrayByteArray :: PrimArray a -> ByteArray
-primArrayByteArray (PrimArray unliftedByteArray) =
-  ByteArray unliftedByteArray
-
-primArrayPrimitiveVector :: Prim a => PrimArray a -> B.Vector a
-primArrayPrimitiveVector primArray =
-  B.Vector 0 (sizeofPrimArray primArray) (primArrayByteArray primArray)
-
-primArrayUnboxedVector :: Prim a => PrimArray a -> A.Vector a
-primArrayUnboxedVector primArray =
-  unsafeCoerce (primArrayPrimitiveVector primArray)
diff --git a/library/PrimitiveExtras/SmallArray.hs b/library/PrimitiveExtras/SmallArray.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/SmallArray.hs
@@ -0,0 +1,170 @@
+module PrimitiveExtras.SmallArray
+where
+
+import PrimitiveExtras.Prelude
+import PrimitiveExtras.Types
+import GHC.Exts hiding (toList)
+import qualified Focus
+
+
+{-# INLINE empty #-}
+empty :: SmallArray a
+empty = runSmallArray (newSmallArray 0 undefined)
+
+{-| A workaround for the weird forcing of 'undefined' values int 'newSmallArray' -}
+{-# INLINE newEmptySmallArray #-}
+newEmptySmallArray :: PrimMonad m => Int -> m (SmallMutableArray (PrimState m) a)
+newEmptySmallArray size = newSmallArray size (unsafeCoerce 0)
+
+{-# INLINE list #-}
+list :: [a] -> SmallArray a
+list list =
+  let
+    !size = length list
+    in runSmallArray $ do
+      m <- newEmptySmallArray size
+      let populate index list = case list of
+            element : list -> do
+              writeSmallArray m index element
+              populate (succ index) list
+            [] -> return m
+          in populate 0 list
+
+-- |
+-- Remove an element.
+{-# INLINE unset #-}
+unset :: Int -> SmallArray a -> SmallArray a
+unset index array =
+  {-# SCC "unset" #-}
+  let !size = sizeofSmallArray array
+      !newSize = pred size
+      !newIndex = succ index
+      !amountOfFollowingElements = size - newIndex
+      in runSmallArray $ do
+        newMa <- newSmallArray newSize undefined
+        copySmallArray newMa 0 array 0 index
+        copySmallArray newMa index array newIndex amountOfFollowingElements
+        return newMa
+
+{-# INLINE set #-}
+set :: Int -> a -> SmallArray a -> SmallArray a
+set index a array =
+  {-# SCC "set" #-} 
+  let
+    !size = sizeofSmallArray array
+    in runSmallArray $ do
+      newMa <- newSmallArray size undefined
+      copySmallArray newMa 0 array 0 size
+      writeSmallArray newMa index a
+      return newMa
+
+{-# INLINE insert #-}
+insert :: Int -> a -> SmallArray a -> SmallArray a
+insert index a array =
+  {-# SCC "insert" #-} 
+  let
+    !size = sizeofSmallArray array
+    !newSize = succ size
+    !nextIndex = succ index
+    !amountOfFollowingElements = size - index
+    in runSmallArray $ do
+      newMa <- newSmallArray newSize a
+      copySmallArray newMa 0 array 0 index
+      copySmallArray newMa nextIndex array index amountOfFollowingElements
+      return newMa
+
+{-# INLINE cons #-}
+cons :: a -> SmallArray a -> SmallArray a
+cons a array =
+  {-# SCC "cons" #-} 
+  let
+    size = sizeofSmallArray array
+    newSize = succ size
+    in runSmallArray $ do
+      newMa <- newSmallArray newSize a
+      copySmallArray newMa 1 array 0 size
+      return newMa
+
+{-# INLINABLE orderedPair #-}
+orderedPair :: Int -> e -> Int -> e -> SmallArray e
+orderedPair i1 e1 i2 e2 =
+  {-# SCC "orderedPair" #-} 
+  runSmallArray $ if 
+    | i1 < i2 -> do
+      a <- newSmallArray 2 e1
+      writeSmallArray a 1 e2
+      return a
+    | i1 > i2 -> do
+      a <- newSmallArray 2 e1
+      writeSmallArray a 0 e2
+      return a
+    | otherwise -> do
+      a <- newSmallArray 1 e2
+      return a
+
+{-# INLINE find #-}
+find :: (a -> Bool) -> SmallArray a -> Maybe a
+find test array =
+  {-# SCC "find" #-} 
+  let
+    !size = sizeofSmallArray array
+    iterate index = if index < size
+      then let
+        element = indexSmallArray array index
+        in if test element
+          then Just element
+          else iterate (succ index)
+      else Nothing
+    in iterate 0
+
+{-# INLINE findWithIndex #-}
+findWithIndex :: (a -> Bool) -> SmallArray a -> Maybe (Int, a)
+findWithIndex test array =
+  {-# SCC "findWithIndex" #-} 
+  let
+    !size = sizeofSmallArray array
+    iterate index = if index < size
+      then let
+        element = indexSmallArray array index
+        in if test element
+          then Just (index, element)
+          else iterate (succ index)
+      else Nothing
+    in iterate 0
+
+{-# INLINABLE elementsUnfoldM #-}
+elementsUnfoldM :: Monad m => SmallArray e -> UnfoldM m e
+elementsUnfoldM array = UnfoldM $ \ step initialState -> let
+  !size = sizeofSmallArray array
+  iterate index !state = if index < size
+    then do
+      element <- indexSmallArrayM array index
+      newState <- step state element
+      iterate (succ index) newState
+    else return state
+  in iterate 0 initialState
+
+{-# INLINABLE onFoundElementFocus #-}
+onFoundElementFocus :: (Monad m, Eq a) => (a -> Bool) -> Focus a m b -> Focus (SmallArray a) m b
+onFoundElementFocus testA (Focus concealA revealA) = Focus concealArray revealArray where
+  concealArray = fmap (fmap arrayChange) concealA where
+    arrayChange = \ case
+      Focus.Set newValue -> Focus.Set (pure newValue)
+      _ -> Focus.Leave
+  revealArray array = case findWithIndex testA array of
+    Just (index, value) -> fmap (fmap arrayChange) (revealA value) where
+      arrayChange = \ case
+        Focus.Leave -> Focus.Leave
+        Focus.Set newValue -> if newValue == value
+          then Focus.Leave
+          else Focus.Set (set index newValue array)
+        Focus.Remove -> if sizeofSmallArray array > 1
+          then Focus.Set (unset index array)
+          else Focus.Remove
+    Nothing -> fmap (fmap arrayChange) concealA where
+      arrayChange = \ case
+        Focus.Set newValue -> Focus.Set (cons newValue array)
+        _ -> Focus.Leave
+
+toList :: forall a. SmallArray a -> [a]
+toList array = PrimitiveExtras.Prelude.toList (elementsUnfoldM array :: UnfoldM Identity a)
diff --git a/library/PrimitiveExtras/SparseSmallArray.hs b/library/PrimitiveExtras/SparseSmallArray.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/SparseSmallArray.hs
@@ -0,0 +1,157 @@
+module PrimitiveExtras.SparseSmallArray
+(
+  SparseSmallArray,
+  empty,
+  singleton,
+  maybeList,
+  pair,
+  insert,
+  replace,
+  unset,
+  lookup,
+  toMaybeList,
+  elementsUnfold,
+  elementsUnfoldM,
+  onElementAtFocus,
+)
+where
+
+import PrimitiveExtras.Prelude hiding (lookup, empty, insert)
+import PrimitiveExtras.Types
+import qualified PrimitiveExtras.Bitmap as Bitmap
+import qualified PrimitiveExtras.SmallArray as SmallArray
+import qualified Focus
+import qualified Control.Foldl as Foldl
+
+
+{-# INLINE empty #-}
+empty :: SparseSmallArray e
+empty = SparseSmallArray Bitmap.empty SmallArray.empty
+
+-- |
+-- An array with a single element at the specified index.
+{-# INLINE singleton #-}
+singleton :: Int -> e -> SparseSmallArray e
+singleton i e = 
+  let b = Bitmap.singleton i
+      a = runST $ newSmallArray 1 e >>= unsafeFreezeSmallArray
+      in SparseSmallArray b a
+
+{-# INLINE pair #-}
+pair :: Int -> e -> Int -> e -> SparseSmallArray e
+pair i1 e1 i2 e2 =
+  {-# SCC "pair" #-} 
+  SparseSmallArray bitmap array
+  where 
+    bitmap = Bitmap.pair i1 i2
+    array = SmallArray.orderedPair i1 e1 i2 e2
+
+{-# INLINE maybeList #-}
+maybeList :: [Maybe e] -> SparseSmallArray e
+maybeList list =
+  SparseSmallArray (Bitmap.boolList (map isJust list)) (SmallArray.list (catMaybes list))
+
+{-|
+Insert an element value at the index.
+It's your obligation to ensure that the index is empty before the operation.
+-}
+{-# INLINE insert #-}
+insert :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+insert i e (SparseSmallArray b a) =
+  {-# SCC "insert" #-} 
+  let
+    sparseIndex = Bitmap.populatedIndex i b
+    in SparseSmallArray (Bitmap.insert i b) (SmallArray.insert sparseIndex e a)
+    
+{-# INLINE replace #-}
+replace :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+replace i e (SparseSmallArray b a) =
+  {-# SCC "replace" #-} 
+  let
+    sparseIndex = Bitmap.populatedIndex i b
+    in SparseSmallArray b (SmallArray.set sparseIndex e a)
+
+-- |
+-- Remove an element.
+{-# INLINE unset #-}
+unset :: Int -> SparseSmallArray e -> SparseSmallArray e
+unset i (SparseSmallArray b a) =
+  {-# SCC "unset" #-}
+  if Bitmap.isPopulated i b
+    then
+      let
+        sparseIndex = Bitmap.populatedIndex i b
+        b' = Bitmap.invert i b
+        a' = SmallArray.unset sparseIndex a
+        in SparseSmallArray b' a'
+    else SparseSmallArray b a
+
+-- |
+-- Lookup an item at the index.
+{-# INLINE lookup #-}
+lookup :: Int -> SparseSmallArray e -> Maybe e
+lookup i (SparseSmallArray b a) =
+  {-# SCC "lookup" #-} 
+  if Bitmap.isPopulated i b
+    then Just (indexSmallArray a (Bitmap.populatedIndex i b))
+    else Nothing
+
+-- |
+-- Convert into a list representation.
+{-# INLINE toMaybeList #-}
+toMaybeList :: SparseSmallArray e -> [Maybe e]
+toMaybeList ssa = do
+  i <- Bitmap.allBitsList
+  return (lookup i ssa)
+
+{-# INLINE elementsUnfold #-}
+elementsUnfold :: SparseSmallArray e -> Unfold e
+elementsUnfold (SparseSmallArray _ array) = Unfold (\ f z -> foldl' f z array)
+
+{-# INLINE elementsUnfoldM #-}
+elementsUnfoldM :: Monad m => SparseSmallArray a -> UnfoldM m a
+elementsUnfoldM (SparseSmallArray _ array) = SmallArray.elementsUnfoldM array
+
+{-# INLINABLE onElementAtFocus #-}
+onElementAtFocus :: Monad m => Int -> Focus a m b -> Focus (SparseSmallArray a) m b
+onElementAtFocus index (Focus concealA revealA) = Focus concealSsa revealSsa where
+  concealSsa = fmap (fmap aChangeToSsaChange) concealA where
+    aChangeToSsaChange = \ case
+      Focus.Leave -> Focus.Leave
+      Focus.Set a -> Focus.Set (SparseSmallArray (Bitmap.singleton index) (pure a))
+      Focus.Remove -> Focus.Leave
+  revealSsa (SparseSmallArray indices array) =
+    fmap (fmap aChangeToSsaChange) $
+    if Bitmap.isPopulated index indices 
+      then do
+        a <- indexSmallArrayM array (Bitmap.populatedIndex index indices)
+        revealA a
+      else concealA
+    where
+      aChangeToSsaChange = \ case
+        Focus.Leave -> Focus.Leave
+        Focus.Set a -> if Bitmap.isPopulated index indices
+          then let
+            newArray = SmallArray.set index a array
+            in Focus.Set (SparseSmallArray indices newArray)
+          else let
+            newIndices = Bitmap.insert index indices
+            newArray = SmallArray.insert index a array
+            in Focus.Set (SparseSmallArray newIndices newArray)
+        Focus.Remove -> let
+          newIndices = Bitmap.invert index indices
+          in if Bitmap.null newIndices
+            then Focus.Remove
+            else let
+              newArray = SmallArray.unset index array
+              in Focus.Set (SparseSmallArray newIndices newArray)
+
+{-# INLINE focusAt #-}
+focusAt :: Monad m => Focus a m b -> Int -> SparseSmallArray a -> m (b, SparseSmallArray a)
+focusAt aFocus index = case onElementAtFocus index aFocus of
+  Focus conceal reveal -> \ ssa -> do
+    (b, change) <- reveal ssa
+    return $ (b,) $ case change of
+      Focus.Leave -> ssa
+      Focus.Set newSsa -> newSsa
+      Focus.Remove -> empty
diff --git a/library/PrimitiveExtras/TVarArray.hs b/library/PrimitiveExtras/TVarArray.hs
new file mode 100644
--- /dev/null
+++ b/library/PrimitiveExtras/TVarArray.hs
@@ -0,0 +1,33 @@
+module PrimitiveExtras.TVarArray
+(
+  TVarArray,
+  new,
+  freezeAsPrimArray,
+  modifyAt,
+)
+where
+
+import PrimitiveExtras.Prelude
+import PrimitiveExtras.Types
+import qualified PrimitiveExtras.UnliftedArray as UnliftedArray
+
+
+new :: a -> Int -> IO (TVarArray a)
+new a size = TVarArray <$> UnliftedArray.replicateIO size (newTVarIO a)
+
+freezeAsPrimArray :: Prim a => TVarArray a -> IO (PrimArray a)
+freezeAsPrimArray (TVarArray varArray) =
+  do
+    let size = sizeofUnliftedArray varArray
+    mpa <- newPrimArray size
+    forMFromZero_ size $ \ index -> do
+      var <- indexUnliftedArrayM varArray index
+      value <- atomically (readTVar var)
+      writePrimArray mpa index value
+    unsafeFreezePrimArray mpa
+
+modifyAt :: TVarArray a -> Int -> (a -> a) -> IO ()
+modifyAt (TVarArray array) index fn =
+  do
+    var <- indexUnliftedArrayM array index
+    atomically $ modifyTVar' var fn
diff --git a/library/PrimitiveExtras/Types.hs b/library/PrimitiveExtras/Types.hs
--- a/library/PrimitiveExtras/Types.hs
+++ b/library/PrimitiveExtras/Types.hs
@@ -7,3 +7,14 @@
 newtype PrimMultiArray a = PrimMultiArray (UnliftedArray (PrimArray a))
 
 newtype TVarArray a = TVarArray (UnliftedArray (TVar a))
+
+{-|
+An immutable space-efficient sparse array, 
+which can only store not more than 32 or 64 elements depending on the system architecure.
+-}
+data SparseSmallArray e = SparseSmallArray !Bitmap !(SmallArray e)
+
+{-|
+A word-size set of ints.
+-}
+newtype Bitmap = Bitmap Int
diff --git a/library/PrimitiveExtras/Unfold.hs b/library/PrimitiveExtras/Unfold.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/Unfold.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module PrimitiveExtras.Unfold
-where
-
-import PrimitiveExtras.Prelude hiding (fold)
-import PrimitiveExtras.Types
-import DeferredFolds.Unfold
-import qualified PrimitiveExtras.Fold as A
-import qualified PrimitiveExtras.UnliftedArray as B
-import qualified PrimitiveExtras.UnfoldM as C
-
-
-primMultiArrayAssocs :: Prim a => PrimMultiArray a -> Unfold (Int, a)
-primMultiArrayAssocs = unfoldM . C.primMultiArrayAssocs
-
-primMultiArrayIndices :: PrimMultiArray a -> Unfold Int
-primMultiArrayIndices (PrimMultiArray ua) =
-  intsInRange 0 (pred (sizeofUnliftedArray ua))
-
-primMultiArrayAt :: Prim prim => PrimMultiArray prim -> Int -> Unfold prim
-primMultiArrayAt (PrimMultiArray ua) index =
-  B.at ua index empty primArray
-
-primArray :: Prim prim => PrimArray prim -> Unfold prim
-primArray ba = Unfold $ \f z -> foldlPrimArray' f z ba
diff --git a/library/PrimitiveExtras/UnfoldM.hs b/library/PrimitiveExtras/UnfoldM.hs
deleted file mode 100644
--- a/library/PrimitiveExtras/UnfoldM.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module PrimitiveExtras.UnfoldM
-where
-
-import PrimitiveExtras.Prelude hiding (fold)
-import PrimitiveExtras.Types
-import DeferredFolds.UnfoldM
-import qualified PrimitiveExtras.Fold as A
-import qualified PrimitiveExtras.UnliftedArray as B
-
-
-primMultiArrayAssocs :: (Monad m, Prim a) => PrimMultiArray a -> UnfoldM m (Int, a)
-primMultiArrayAssocs pma =
-  do
-    index <- primMultiArrayIndices pma
-    element <- primMultiArrayAt pma index
-    return (index, element)
-
-primMultiArrayIndices :: Monad m => PrimMultiArray a -> UnfoldM m Int
-primMultiArrayIndices (PrimMultiArray ua) =
-  intsInRange 0 (pred (sizeofUnliftedArray ua))
-
-primMultiArrayAt :: (Monad m, Prim prim) => PrimMultiArray prim -> Int -> UnfoldM m prim
-primMultiArrayAt (PrimMultiArray ua) index =
-  B.at ua index empty primArray
-
-primArray :: (Monad m, Prim prim) => PrimArray prim -> UnfoldM m prim
-primArray ba = UnfoldM $ \f z -> foldlPrimArrayM' f z ba
diff --git a/library/PrimitiveExtras/UnliftedArray.hs b/library/PrimitiveExtras/UnliftedArray.hs
--- a/library/PrimitiveExtras/UnliftedArray.hs
+++ b/library/PrimitiveExtras/UnliftedArray.hs
@@ -11,6 +11,7 @@
     then none
     else some (indexUnliftedArray ua index)
 
+{-# INLINABLE replicateIO #-}
 replicateIO :: PrimUnlifted a => Int -> IO a -> IO (UnliftedArray a)
 replicateIO size elementIO =
   do
@@ -25,6 +26,7 @@
           else unsafeFreezeUnliftedArray array
       in loop 0
 
+{-# INLINABLE generate #-}
 generate :: PrimUnlifted a => Int -> (Int -> IO a) -> IO (UnliftedArray a)
 generate size elementIO =
   do
@@ -38,3 +40,15 @@
             loop (succ index)
           else unsafeFreezeUnliftedArray array
       in loop 0
+
+traverse_ :: (Monad m, PrimUnlifted a) => (a -> m ()) -> UnliftedArray a -> m ()
+traverse_ action array =
+  let
+    size = sizeofUnliftedArray array
+    iterate index = if index < size
+      then do
+        element <- indexUnliftedArrayM array index
+        action element
+        iterate (succ index)
+      else return ()
+    in iterate 0
diff --git a/primitive-extras.cabal b/primitive-extras.cabal
--- a/primitive-extras.cabal
+++ b/primitive-extras.cabal
@@ -1,7 +1,7 @@
 name:
   primitive-extras
 version:
-  0.3.0.1
+  0.4
 category:
   Primitive
 synopsis:
@@ -39,25 +39,48 @@
   default-language:
     Haskell2010
   exposed-modules:
-    PrimitiveExtras.Data
-    PrimitiveExtras.Monad
-    PrimitiveExtras.IO
-    PrimitiveExtras.Unfold
-    PrimitiveExtras.UnfoldM
-    PrimitiveExtras.Fold
-    PrimitiveExtras.Pure
-    PrimitiveExtras.Cereal.Get
-    PrimitiveExtras.Cereal.Put
-  other-modules:
+    PrimitiveExtras.Bitmap
+    PrimitiveExtras.SmallArray
+    PrimitiveExtras.SparseSmallArray
+    PrimitiveExtras.TVarArray
+    PrimitiveExtras.PrimArray
     PrimitiveExtras.UnliftedArray
+    PrimitiveExtras.PrimMultiArray
+  other-modules:
     PrimitiveExtras.Prelude
     PrimitiveExtras.Types
-    PrimitiveExtras.Instances
+    PrimitiveExtras.Folds
   build-depends:
     base >=4.7 && <5,
     cereal >=0.5.5 && <0.6,
-    deferred-folds >=0.6 && <0.7,
+    deferred-folds >=0.6.5 && <0.7,
+    focus >=0.11.2.1 && <0.12,
     foldl >=1 && <2,
     primitive >=0.6.4 && <0.7,
     profunctors >=5 && <6,
     vector >=0.12 && <0.13
+
+test-suite test
+  type:
+    exitcode-stdio-1.0
+  hs-source-dirs:
+    test
+  main-is:
+    Main.hs
+  other-modules:
+    Main.Gens
+    Main.Transaction
+  default-extensions:
+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples
+  default-language:
+    Haskell2010
+  build-depends:
+    deferred-folds,
+    focus,
+    primitive-extras,
+    QuickCheck >=2.8.1 && <3,
+    quickcheck-instances >=0.3.11 && <0.4,
+    rerebase <2,
+    tasty >=0.12 && <2,
+    tasty-hunit >=0.9 && <0.11,
+    tasty-quickcheck >=0.9 && <0.11
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,81 @@
+module Main where
+
+import Prelude
+import Test.QuickCheck.Instances
+import Test.Tasty
+import Test.Tasty.Runners
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+import PrimitiveExtras.SparseSmallArray (SparseSmallArray)
+import qualified Test.QuickCheck as QuickCheck
+import qualified Test.QuickCheck.Property as QuickCheck
+import qualified Main.Transaction as Transaction
+import qualified Main.Gens as Gen
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+import qualified PrimitiveExtras.SmallArray as SmallArray
+
+
+main =
+  defaultMain $
+  testGroup "All" $
+  [
+    testGroup "SmallArray" $
+    [
+      testCase "set" $ let
+        array = SmallArray.list [1, 2, 3]
+        in assertEqual ""
+          [1, 4, 3]
+          (SmallArray.toList (SmallArray.set 1 4 array))
+      ,
+      testCase "insert" $ let
+        array = SmallArray.list [1, 2, 3]
+        in assertEqual ""
+          [1, 4, 2, 3]
+          (SmallArray.toList (SmallArray.insert 1 4 array))
+      ,
+      testCase "unset" $ let
+        array = SmallArray.list [1, 2, 3]
+        in assertEqual ""
+          [1, 3]
+          (SmallArray.toList (SmallArray.unset 1 array))
+    ]
+    ,
+    testGroup "SparseSmallArray" $
+    [
+      testCase "empty" $ do
+        assertEqual ""
+          (replicate (finiteBitSize (undefined :: Int)) Nothing)
+          (SparseSmallArray.toMaybeList (SparseSmallArray.empty :: SparseSmallArray Int32))
+      ,
+      testProperty "toMaybeList, maybeList" $ forAll Gen.maybeList $ \ maybeList ->
+      maybeList === SparseSmallArray.toMaybeList (SparseSmallArray.maybeList maybeList)
+      ,
+      testCase "unset" $ assertEqual ""
+        ([Just 1, Nothing, Nothing, Just 3] <> replicate (finiteBitSize (undefined :: Int) - 4) Nothing)
+        (SparseSmallArray.toMaybeList (SparseSmallArray.unset 1 (SparseSmallArray.maybeList [Just 1, Just 2, Nothing, Just 3])))
+      ,
+      testTransactionProperty "set" Gen.setTransaction
+      ,
+      testTransactionProperty "unset" Gen.unsetTransaction
+      ,
+      testTransactionProperty "unfold" Gen.unfoldTransaction
+      ,
+      testTransactionProperty "lookup" Gen.lookupTransaction
+      ,
+      testTransactionProperty "composite" Gen.transaction
+    ]
+  ]
+
+testTransactionProperty name transactionGen =
+  testProperty (showString "Transaction: " name) $
+  forAll ((,) <$> Gen.maybeList <*> transactionGen) $ \ (maybeList, transaction) ->
+  case transaction of
+    Transaction.Transaction name applyToMaybeList applyToSparseSmallArray -> let
+      ssa = SparseSmallArray.maybeList maybeList
+      (result1, newMaybeList) = runState applyToMaybeList maybeList
+      (result2, newSsa) = runState applyToSparseSmallArray ssa
+      newSsaMaybeList = SparseSmallArray.toMaybeList newSsa
+      in
+        QuickCheck.counterexample
+          ("transaction: " <> show name <> "\nnewMaybeList1: " <> show newMaybeList <> "\nnewMaybeList2: " <> show newSsaMaybeList <> "\nresult1: " <> show result1 <> "\nresult2: " <> show result2)
+          (newMaybeList == SparseSmallArray.toMaybeList newSsa && result1 == result2)
diff --git a/test/Main/Gens.hs b/test/Main/Gens.hs
new file mode 100644
--- /dev/null
+++ b/test/Main/Gens.hs
@@ -0,0 +1,48 @@
+module Main.Gens where
+
+import Prelude hiding (choose, index)
+import Test.QuickCheck.Gen
+import Focus (Focus(..))
+import Main.Transaction (Transaction)
+import qualified Main.Transaction as Transaction
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+
+
+element :: Gen Int
+element = choose (0, 999)
+
+index :: Gen Int
+index = choose (0, 9)
+
+lookupTransaction :: (Show element, Eq element) => Gen (Transaction element)
+lookupTransaction = Transaction.lookup <$> index
+
+setTransaction :: Gen (Transaction Int)
+setTransaction = Transaction.set <$> index <*> element
+
+unsetTransaction :: Gen (Transaction element)
+unsetTransaction = Transaction.unset <$> index
+
+unfoldTransaction :: (Show element, Eq element) => Gen (Transaction element)
+unfoldTransaction = pure Transaction.elementsUnfold
+
+transaction :: Gen (Transaction Int)
+transaction =
+  frequency
+    [
+      (9, lookupTransaction),
+      (9, setTransaction),
+      (9, unsetTransaction)
+    ]
+
+maybeList :: Gen [Maybe Int]
+maybeList =
+  replicateM (finiteBitSize (undefined :: Int)) $ frequency $
+  [
+    (4, fmap Just element),
+    (1, pure Nothing)
+  ]
+
+sparseSmallArray :: Gen (SparseSmallArray.SparseSmallArray Int)
+sparseSmallArray =
+  SparseSmallArray.maybeList <$> maybeList
diff --git a/test/Main/Transaction.hs b/test/Main/Transaction.hs
new file mode 100644
--- /dev/null
+++ b/test/Main/Transaction.hs
@@ -0,0 +1,91 @@
+module Main.Transaction where
+
+import Prelude
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+import qualified Data.Text as Text
+import qualified DeferredFolds.Unfold as Unfold
+
+
+data Transaction element = forall result. (Show result, Eq result) => Transaction {
+  name :: Text,
+  applyToMaybeList :: State [Maybe element] result,
+  applyToSparseSmallArray :: State (SparseSmallArray.SparseSmallArray element) result
+}
+
+instance Show (Transaction element) where
+  show = Text.unpack . name
+
+singleton :: Show element => Int -> element -> Transaction element
+singleton index element =
+  Transaction {
+    name = "singleton " <> (fromString . show) index <> " " <> fromString (show element)
+    ,
+    applyToMaybeList =
+      put $ map (\i' -> if index == i' then Just element else Nothing) [0 .. pred (finiteBitSize (undefined :: Int))]
+    ,
+    applyToSparseSmallArray =
+      put $ SparseSmallArray.singleton index element
+  }
+
+set :: Show element => Int -> element -> Transaction element
+set index element =
+  Transaction {
+    name = "set " <> (fromString . show) index <> " " <> (fromString . show) element
+    ,
+    applyToMaybeList = do
+      l <- get
+      put $ do
+        (i', e') <- zip [0..] l
+        return $ if index == i' then Just element else e'
+    ,
+    applyToSparseSmallArray = do
+      ssa <- get
+      case SparseSmallArray.lookup index ssa of
+        Just _ -> put (SparseSmallArray.replace index element ssa)
+        Nothing -> put (SparseSmallArray.insert index element ssa)
+  }
+
+unset :: Int -> Transaction element
+unset index =
+  Transaction {
+    name = "unset " <> fromString (show index)
+    ,
+    applyToMaybeList = do
+      l <- get
+      put $ do
+        (i', e') <- zip [0..] l
+        return $ if index == i' then Nothing else e'
+    ,
+    applyToSparseSmallArray =
+      get >>= put . (SparseSmallArray.unset index)
+  }
+
+lookup :: (Show element, Eq element) => Int -> Transaction element
+lookup index =
+  Transaction {
+    name = "lookup " <> fromString (show index),
+    applyToMaybeList = fmap (join . fmap fst . uncons . drop index) get,
+    applyToSparseSmallArray = fmap (SparseSmallArray.lookup index) get
+  }
+
+elementsUnfold :: (Show element, Eq element) => Transaction element
+elementsUnfold =
+  Transaction {
+    name = "elementsUnfold",
+    applyToMaybeList = do
+      list <- get
+      return $ do
+        maybeElement <- Unfold.foldable list
+        element <- Unfold.foldable maybeElement
+        return element,
+    applyToSparseSmallArray = fmap SparseSmallArray.elementsUnfold get
+  }
+
+-- focusInsert :: Show element => Int -> element -> Transaction element
+-- focusInsert index element =
+--   Transaction {
+--     name = "focusInsert " <> (fromString . show) index <> " " <> (fromString . show) element,
+--     applyToMaybeList = do
+--       list <- get
+
+--   }