diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2016, Nikita Volkov
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/concurrent-insertion-bench/Main.hs b/concurrent-insertion-bench/Main.hs
new file mode 100644
--- /dev/null
+++ b/concurrent-insertion-bench/Main.hs
@@ -0,0 +1,114 @@
+module Main where
+
+import Rebase.Prelude
+import Criterion.Main
+import Control.Monad.Free
+import Control.Monad.Free.TH
+import qualified StmHamt.Hamt as A
+import qualified Control.Concurrent.Async as B
+import qualified System.Random.MWC.Monad as C
+import qualified Focus as D
+import qualified Rebase.Data.Text as E
+import qualified Rebase.Data.Vector as F
+
+
+-- * Transactions 
+-------------------------
+
+data TransactionF row n where
+  Insert :: row -> n -> TransactionF row n
+  deriving (Functor)
+
+type Transaction row = Free (TransactionF row)
+
+
+-- * Interpreters
+-------------------------
+
+type Interpreter container = 
+  forall row. (Hashable row, Eq row) => container row -> forall result. Transaction row result -> STM result
+
+specializedInterpreter :: Interpreter A.Hamt
+specializedInterpreter container =
+  iterM $ \case
+    Insert row continue -> A.insert id row container >> continue
+
+focusInterpreter :: Interpreter A.Hamt
+focusInterpreter container =
+  iterM $ \case
+    Insert row continue -> A.focus (D.insert row) id row container >> continue
+
+
+-- * Session and runners
+-------------------------
+
+-- | A list of transactions per thread.
+type Session row = [[Transaction row ()]]
+
+type SessionRunner = 
+  forall row. (Hashable row, Eq row) => Session row -> IO ()
+
+sessionRunner :: Interpreter A.Hamt -> SessionRunner
+sessionRunner interpreter threadTransactions = do
+  m <- atomically $ A.new
+  void $ flip B.mapConcurrently threadTransactions $ \actions -> do
+    forM_ actions $ atomically . interpreter m
+
+
+-- * Generators
+-------------------------
+
+type Generator a = C.Rand IO a
+
+transactionGenerator :: Generator (Transaction Text ())
+transactionGenerator = do
+  text <- textGenerator
+  return $ Free $ Insert text (Pure ())
+
+textGenerator :: Generator Text
+textGenerator = do
+  l <- length
+  s <- replicateM l char
+  return $! E.pack s
+  where
+    length =
+      C.uniformR (7, 20)
+    char =
+      chr <$> C.uniformR (ord 'a', ord 'z')
+
+
+-- * Utils
+-------------------------
+
+slices :: Int -> [a] -> [[a]]
+slices size l =
+  case splitAt size l of
+    ([], _) -> []
+    (a, b) -> a : slices size b
+
+
+-- * Main
+-------------------------
+
+main = do
+  allTransactions <- C.runWithSeed seed $ replicateM actionsNum transactionGenerator
+  defaultMain $! flip map threadsNums $! \threadsNum ->
+    let
+      sliceSize = actionsNum `div` threadsNum
+      threadTransactions = slices sliceSize allTransactions
+      in 
+        bgroup
+          (shows threadsNum . showString "/" . shows sliceSize $ "")
+          [
+            bench "Focus-based" $ nfIO $
+              sessionRunner focusInterpreter threadTransactions,
+            bench "Specialized" $ nfIO $
+              sessionRunner specializedInterpreter threadTransactions
+          ]
+  where
+    seed =
+      C.toSeed (F.fromList [1..7])
+    actionsNum =
+      100000
+    threadsNums =
+      [1, 2, 4, 6, 8, 12, 16, 32, 40, 52, 64, 80, 128]
diff --git a/library/StmHamt/Accessors/Hash.hs b/library/StmHamt/Accessors/Hash.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Accessors/Hash.hs
@@ -0,0 +1,17 @@
+module StmHamt.Accessors.Hash where
+
+import StmHamt.Prelude hiding (mask)
+import StmHamt.Types
+
+
+{-# INLINE index #-}
+index :: Int -> Int
+index hash = mask .&. hash
+
+{-# INLINE step #-}
+step :: Int
+step = 5
+
+{-# NOINLINE mask #-}
+mask :: Int
+mask = bit step - 1
diff --git a/library/StmHamt/Constructors/Branch.hs b/library/StmHamt/Constructors/Branch.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Constructors/Branch.hs
@@ -0,0 +1,21 @@
+module StmHamt.Constructors.Branch where
+
+import StmHamt.Prelude
+import StmHamt.Types
+import qualified StmHamt.Accessors.Hash as HashAccessors
+import qualified StmHamt.Constructors.Hash as HashConstructors
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+
+
+singleton :: Int -> a -> Branch a
+singleton hash a = LeavesBranch hash (pure a)
+
+pair :: Int -> Branch a -> Int -> Branch a -> STM (Branch a)
+pair hash1 branch1 hash2 branch2 =
+  {-# SCC "pair" #-}
+  let
+    index1 = HashAccessors.index hash1
+    index2 = HashAccessors.index hash2
+    in if index1 == index2
+      then pair (HashConstructors.succLevel hash1) branch1 (HashConstructors.succLevel hash2) branch2
+      else BranchesBranch . Hamt <$> newTVar (SparseSmallArray.pair index1 branch1 index2 branch2)
diff --git a/library/StmHamt/Constructors/Hash.hs b/library/StmHamt/Constructors/Hash.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Constructors/Hash.hs
@@ -0,0 +1,10 @@
+module StmHamt.Constructors.Hash where
+
+import StmHamt.Prelude
+import StmHamt.Types
+import qualified StmHamt.Accessors.Hash as HashAccessors
+
+
+{-# INLINE succLevel #-}
+succLevel :: Int -> Int
+succLevel hash = unsafeShiftR hash HashAccessors.step
diff --git a/library/StmHamt/Focuses.hs b/library/StmHamt/Focuses.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Focuses.hs
@@ -0,0 +1,60 @@
+{-|
+Utility focuses.
+-}
+module StmHamt.Focuses where
+
+import StmHamt.Prelude
+import StmHamt.Types
+import Focus
+import qualified StmHamt.Accessors.Hash as HashAccessors
+import qualified StmHamt.Constructors.Branch as BranchConstructors
+import qualified StmHamt.Constructors.Hash as HashConstructors
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+import qualified PrimitiveExtras.SmallArray as SmallArray
+
+
+onBranchElement :: forall a b. Int -> (a -> Bool) -> Focus a STM b -> Focus (Branch a) STM b
+onBranchElement hash testA aFocus@(Focus concealA revealA) =
+  let
+    Focus concealLeaves revealLeaves = SmallArray.onFoundElementFocus testA (const False) aFocus
+    branchesFocus :: Int -> Focus (TVar (SparseSmallArray (Branch a))) STM b
+    branchesFocus hash = let
+      !branchIndex = HashAccessors.index hash
+      in onTVarValue (SparseSmallArray.onElementAtFocus branchIndex (branchFocus hash))
+    branchFocus :: Int -> Focus (Branch a) STM b
+    branchFocus hash = Focus concealBranch revealBranch where
+      Focus concealBranchesVar revealBranchesVar = branchesFocus (HashConstructors.succLevel hash)
+      concealBranch = fmap (fmap (fmap (LeavesBranch hash))) concealLeaves
+      revealBranch = \ case
+        LeavesBranch leavesHash leavesArray -> case leavesHash == hash of
+          True -> fmap (fmap (fmap (LeavesBranch leavesHash))) (revealLeaves leavesArray)
+          False -> concealA >>= traverse interpretChange where
+            interpretChange = \ case
+              Set newA -> let
+                newHash = HashConstructors.succLevel hash
+                newLeavesHash = HashConstructors.succLevel leavesHash
+                in Set <$> BranchConstructors.pair newHash (BranchConstructors.singleton newHash newA) newLeavesHash (LeavesBranch newLeavesHash leavesArray)
+              _ -> return Leave
+        BranchesBranch (Hamt var) -> fmap (fmap (fmap (BranchesBranch . Hamt))) (revealBranchesVar var)
+    in branchFocus hash
+
+onHamtElement :: Int -> (a -> Bool) -> Focus a STM b -> Focus (Hamt a) STM b
+onHamtElement hash test focus =
+  let
+    !branchIndex = HashAccessors.index hash
+    Focus concealBranches revealBranches =
+      SparseSmallArray.onElementAtFocus branchIndex $
+      onBranchElement hash test focus
+    concealHamt = concealBranches >>= traverse hamtChangeStm where
+      hamtChangeStm = \ case
+        Leave -> return Leave
+        Set !branches -> Set . Hamt <$> newTVar branches
+        Remove -> Set . Hamt <$> newTVar SparseSmallArray.empty
+    revealHamt (Hamt branchesVar) = do
+      branches <- readTVar branchesVar
+      (result, branchesChange) <- revealBranches branches
+      case branchesChange of
+        Leave -> return (result, Leave)
+        Set !newBranches -> writeTVar branchesVar newBranches $> (result, Leave)
+        Remove -> writeTVar branchesVar SparseSmallArray.empty $> (result, Leave)
+    in Focus concealHamt revealHamt
diff --git a/library/StmHamt/Hamt.hs b/library/StmHamt/Hamt.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Hamt.hs
@@ -0,0 +1,125 @@
+module StmHamt.Hamt
+(
+  Hamt,
+  new,
+  newIO,
+  null,
+  focus,
+  focusExplicitly,
+  insert,
+  insertExplicitly,
+  lookup,
+  lookupExplicitly,
+  reset,
+  unfoldM,
+)
+where
+
+import StmHamt.Prelude hiding (empty, insert, update, lookup, delete)
+import StmHamt.Types
+import qualified Focus as Focus
+import qualified StmHamt.Focuses as Focuses
+import qualified StmHamt.Constructors.Hash as HashConstructors
+import qualified StmHamt.Accessors.Hash as HashAccessors
+import qualified StmHamt.UnfoldMs as UnfoldMs
+import qualified PrimitiveExtras.SmallArray as SmallArray
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+
+
+new :: STM (Hamt a)
+new = Hamt <$> newTVar SparseSmallArray.empty
+
+newIO :: IO (Hamt a)
+newIO = Hamt <$> newTVarIO SparseSmallArray.empty
+
+pair :: Int -> Branch a -> Int -> Branch a -> STM (Hamt a)
+pair hash1 branch1 hash2 branch2 =
+  {-# SCC "pair" #-}
+  let
+    index1 = HashAccessors.index hash1
+    index2 = HashAccessors.index hash2
+    in if index1 == index2
+      then pair (HashConstructors.succLevel hash1) branch1 (HashConstructors.succLevel hash2) branch2
+      else Hamt <$> newTVar (SparseSmallArray.pair index1 branch1 index2 branch2)
+
+focus :: (Eq key, Hashable key) => Focus element STM result -> (element -> key) -> key -> Hamt element -> STM result
+focus focus elementToKey key = focusExplicitly focus (hash key) ((==) key . elementToKey)
+
+focusExplicitly :: Focus a STM b -> Int -> (a -> Bool) -> Hamt a -> STM b
+focusExplicitly focus hash test hamt =
+  {-# SCC "focus" #-} 
+  let
+    Focus conceal reveal = Focuses.onHamtElement hash test focus
+    in fmap fst (reveal hamt)
+
+{-|
+Returns a flag, specifying, whether the size has been affected.
+-}
+insert :: (Eq key, Hashable key) => (element -> key) -> element -> Hamt element -> STM Bool
+insert elementToKey element = let
+  !key = elementToKey element
+  in insertExplicitly (hash key) ((==) key . elementToKey) element
+
+{-|
+Returns a flag, specifying, whether the size has been affected.
+-}
+insertExplicitly :: Int -> (a -> Bool) -> a -> Hamt a -> STM Bool
+insertExplicitly hash testKey element (Hamt var) =
+  {-# SCC "insertExplicitly" #-} 
+  let
+    !branchIndex = HashAccessors.index hash
+    in do
+      branchArray <- readTVar var
+      case SparseSmallArray.lookup branchIndex branchArray of
+        Nothing -> do
+          writeTVar var $! SparseSmallArray.insert branchIndex (LeavesBranch hash (pure element)) branchArray
+          return True
+        Just branch -> case branch of
+          LeavesBranch leavesHash leavesArray -> if leavesHash == hash
+            then case SmallArray.findWithIndex testKey leavesArray of
+              Just (leavesIndex, leavesElement) -> do
+                let
+                  !newLeavesArray = SmallArray.set leavesIndex element leavesArray
+                  !newBranch = LeavesBranch hash newLeavesArray
+                  !newBranchArray = SparseSmallArray.replace branchIndex newBranch branchArray
+                  in do
+                    writeTVar var newBranchArray
+                    return False
+              Nothing -> do
+                writeTVar var $! SparseSmallArray.replace branchIndex (LeavesBranch hash (SmallArray.cons element leavesArray)) branchArray
+                return True
+            else let
+              nextHash = HashConstructors.succLevel hash
+              nextLeavesHash = HashConstructors.succLevel leavesHash
+              in do
+                hamt <- pair nextHash (LeavesBranch nextHash (pure element)) nextLeavesHash (LeavesBranch nextLeavesHash leavesArray)
+                writeTVar var $! SparseSmallArray.replace branchIndex (BranchesBranch hamt) branchArray
+                return True
+          BranchesBranch hamt -> insertExplicitly (HashConstructors.succLevel hash) testKey element hamt
+
+{-|
+Returns a flag, specifying, whether the size has been affected.
+-}
+lookup :: (Eq key, Hashable key) => (element -> key) -> key -> Hamt element -> STM (Maybe element)
+lookup elementToKey key = lookupExplicitly (hash key) ((==) key . elementToKey)
+
+lookupExplicitly :: Int -> (a -> Bool) -> Hamt a -> STM (Maybe a)
+lookupExplicitly hash test (Hamt var) =
+  {-# SCC "lookupExplicitly" #-}
+  let
+    !index = HashAccessors.index hash
+    in do
+      branchArray <- readTVar var
+      case SparseSmallArray.lookup index branchArray of
+        Just branch -> case branch of
+          LeavesBranch leavesHash leavesArray -> if leavesHash == hash
+            then return (SmallArray.find test leavesArray)
+            else return Nothing
+          BranchesBranch hamt -> lookupExplicitly (HashConstructors.succLevel hash) test hamt
+        Nothing -> return Nothing
+
+reset :: Hamt a -> STM ()
+reset (Hamt branchSsaVar) = writeTVar branchSsaVar SparseSmallArray.empty
+
+unfoldM :: Hamt a -> UnfoldM STM a
+unfoldM = UnfoldMs.hamtElements
diff --git a/library/StmHamt/Prelude.hs b/library/StmHamt/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Prelude.hs
@@ -0,0 +1,116 @@
+module StmHamt.Prelude
+( 
+  module Exports,
+  traversePair,
+  modifyTVar',
+  forMInPositiveRange_,
+  forMInNegativeRange_,
+)
+where
+
+-- base
+-------------------------
+import Control.Applicative as Exports
+import Control.Arrow as Exports
+import Control.Category as Exports
+import Control.Concurrent as Exports
+import Control.Exception as Exports
+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.IO.Class as Exports
+import Control.Monad.Fix as Exports hiding (fix)
+import Control.Monad.ST as Exports
+import Data.Bits as Exports
+import Data.Bool as Exports
+import Data.Char as Exports
+import Data.Coerce as Exports
+import Data.Complex as Exports
+import Data.Data as Exports
+import Data.Dynamic as Exports
+import Data.Either as Exports
+import Data.Fixed as Exports
+import Data.Foldable as Exports
+import Data.Function as Exports hiding (id, (.))
+import Data.Functor as Exports
+import Data.Int as Exports
+import Data.IORef as Exports
+import Data.Ix as Exports
+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+import Data.Maybe as Exports
+import Data.Monoid as Exports hiding (Last(..), First(..))
+import Data.Ord as Exports
+import Data.Proxy as Exports
+import Data.Ratio as Exports
+import Data.STRef as Exports
+import Data.String as Exports
+import Data.Traversable as Exports
+import Data.Tuple as Exports
+import Data.Unique as Exports
+import Data.Version as Exports
+import Data.Word as Exports
+import Debug.Trace as Exports
+import Foreign.ForeignPtr as Exports
+import Foreign.Ptr as Exports
+import Foreign.StablePtr as Exports
+import Foreign.Storable as Exports hiding (sizeOf, alignment)
+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)
+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)
+import GHC.Generics as Exports (Generic)
+import GHC.IO.Exception as Exports
+import Numeric as Exports
+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))
+import System.Environment as Exports
+import System.Exit as Exports
+import System.IO as Exports
+import System.IO.Error as Exports
+import System.IO.Unsafe as Exports
+import System.Mem as Exports
+import System.Mem.StableName as Exports
+import System.Timeout as Exports
+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)
+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)
+import Text.Printf as Exports (printf, hPrintf)
+import Text.Read as Exports (Read(..), readMaybe, readEither)
+import Unsafe.Coerce as Exports
+
+-- hashable
+-------------------------
+import Data.Hashable as Exports (Hashable(..))
+
+-- focus
+-------------------------
+import Focus as Exports (Focus(..))
+
+-- primitive
+-------------------------
+import Data.Primitive as Exports
+
+-- primitive-extras
+-------------------------
+import PrimitiveExtras.SparseSmallArray as Exports (SparseSmallArray)
+
+-- deferred-folds
+-------------------------
+import DeferredFolds.Unfold as Exports (Unfold(..))
+import DeferredFolds.UnfoldM as Exports (UnfoldM(..))
+
+-- | A replacement for the missing 'Traverse' instance of pair in base < 4.7.
+{-# INLINE traversePair #-}
+traversePair :: Functor f => (a -> f b) -> (c, a) -> f (c, b)
+traversePair f (x, y) = (,) x <$> f y
+
+-- | Strict version of 'modifyTVar'.
+{-# INLINE modifyTVar' #-}
+modifyTVar' :: TVar a -> (a -> a) -> STM ()
+modifyTVar' var f = do
+    x <- readTVar var
+    writeTVar var $! f x
+
+{-# INLINE forMInPositiveRange_ #-}
+forMInPositiveRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m ()
+forMInPositiveRange_ !startN !endN f =
+  ($ startN) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()
+
+{-# INLINE forMInNegativeRange_ #-}
+forMInNegativeRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m ()
+forMInNegativeRange_ !startN !endN f =
+  ($ pred startN) $ fix $ \loop !n -> if n >= endN then f n *> loop (pred n) else pure ()
diff --git a/library/StmHamt/SizedHamt.hs b/library/StmHamt/SizedHamt.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/SizedHamt.hs
@@ -0,0 +1,76 @@
+-- |
+-- HAMT API,
+-- optimized for a fast 'size' operation.
+-- That however comes at the cost of a small overhead in the other operations.
+module StmHamt.SizedHamt
+(
+  SizedHamt,
+  new,
+  newIO,
+  null,
+  size,
+  focus,
+  insert,
+  lookup,
+  reset,
+  unfoldM,
+)
+where
+
+import StmHamt.Prelude hiding (insert, lookup, delete, fold, null)
+import StmHamt.Types
+import qualified Focus as Focus
+import qualified StmHamt.Hamt as Hamt
+
+
+{-# INLINE new #-}
+new :: STM (SizedHamt element)
+new = SizedHamt <$> Hamt.new <*> newTVar 0
+
+{-# INLINE newIO #-}
+newIO :: IO (SizedHamt element)
+newIO = SizedHamt <$> Hamt.newIO <*> newTVarIO 0
+
+-- |
+-- /O(1)/.
+{-# INLINE null #-}
+null :: SizedHamt element -> STM Bool
+null (SizedHamt _ sizeVar) = (== 0) <$> readTVar sizeVar
+
+-- |
+-- /O(1)/.
+{-# INLINE size #-}
+size :: SizedHamt element -> STM Int
+size (SizedHamt _ sizeVar) = readTVar sizeVar
+
+{-# INLINE reset #-}
+reset :: SizedHamt element -> STM ()
+reset (SizedHamt hamt sizeVar) =
+  do
+    Hamt.reset hamt
+    writeTVar sizeVar 0
+
+{-# INLINE focus #-}
+focus :: (Eq key, Hashable key) => Focus element STM result -> (element -> key) -> key -> SizedHamt element -> STM result
+focus focus elementToKey key (SizedHamt hamt sizeVar) =
+  do
+    (result, sizeModifier) <- Hamt.focus newFocus elementToKey key hamt
+    forM_ sizeModifier (modifyTVar' sizeVar)
+    return result
+  where
+    newFocus = Focus.testingSizeChange (Just pred) Nothing (Just succ) focus
+
+{-# INLINE insert #-}
+insert :: (Eq key, Hashable key) => (element -> key) -> element -> SizedHamt element -> STM ()
+insert elementToKey element (SizedHamt hamt sizeVar) =
+  do
+    inserted <- Hamt.insert elementToKey element hamt
+    when inserted (modifyTVar' sizeVar succ)
+
+{-# INLINE lookup #-}
+lookup :: (Eq key, Hashable key) => (element -> key) -> key -> SizedHamt element -> STM (Maybe element)
+lookup elementToKey key (SizedHamt hamt _) = Hamt.lookup elementToKey key hamt
+
+{-# INLINE unfoldM #-}
+unfoldM :: SizedHamt a -> UnfoldM STM a
+unfoldM (SizedHamt hamt _) = Hamt.unfoldM hamt
diff --git a/library/StmHamt/Types.hs b/library/StmHamt/Types.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/Types.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+module StmHamt.Types where
+
+import StmHamt.Prelude
+
+{-|
+STM-specialized Hash Array Mapped Trie,
+extended with its size-tracking functionality,
+allowing for a fast 'size' operation.
+-}
+data SizedHamt element = SizedHamt !(Hamt element) !(TVar Int)
+
+{-|
+STM-specialized Hash Array Mapped Trie.
+-}
+newtype Hamt element = Hamt (TVar (SparseSmallArray (Branch element)))
+
+data Branch element = BranchesBranch !(Hamt element) | LeavesBranch !Int !(SmallArray element)
diff --git a/library/StmHamt/UnfoldMs.hs b/library/StmHamt/UnfoldMs.hs
new file mode 100644
--- /dev/null
+++ b/library/StmHamt/UnfoldMs.hs
@@ -0,0 +1,16 @@
+module StmHamt.UnfoldMs where
+
+import StmHamt.Prelude hiding (filter, all)
+import StmHamt.Types
+import DeferredFolds.UnfoldM
+import qualified PrimitiveExtras.SmallArray as SmallArray
+import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray
+
+
+hamtElements :: Hamt a -> UnfoldM STM a
+hamtElements (Hamt var) = tVarValue var >>= SparseSmallArray.elementsUnfoldM >>= branchElements
+
+branchElements :: Branch a -> UnfoldM STM a
+branchElements = \ case
+  LeavesBranch _ array -> SmallArray.elementsUnfoldM array
+  BranchesBranch hamt -> hamtElements hamt
diff --git a/stm-hamt.cabal b/stm-hamt.cabal
new file mode 100644
--- /dev/null
+++ b/stm-hamt.cabal
@@ -0,0 +1,115 @@
+name:
+  stm-hamt
+version:
+  1
+synopsis:
+  STM-specialised Hash Array Mapped Trie
+description:
+  A low-level data-structure,
+  which can be used to implement higher-level interfaces like
+  hash-map and hash-set.
+  Such implementations are presented by
+  <http://hackage.haskell.org/package/stm-containers the "stm-containers" library>.
+category:
+  Data Structures, STM, Concurrency
+homepage:
+  https://github.com/nikita-volkov/stm-hamt
+bug-reports:
+  https://github.com/nikita-volkov/stm-hamt/issues
+author:
+  Nikita Volkov <nikita.y.volkov@mail.ru>
+maintainer:
+  Nikita Volkov <nikita.y.volkov@mail.ru>
+copyright:
+  (c) 2016, Nikita Volkov
+license:
+  MIT
+license-file:
+  LICENSE
+build-type:
+  Simple
+cabal-version:
+  >=1.10
+
+source-repository head
+  type:
+    git
+  location:
+    git://github.com/nikita-volkov/stm-hamt.git
+
+library
+  hs-source-dirs:
+    library
+  default-extensions:
+    Arrows, BangPatterns, BinaryLiterals, 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
+  exposed-modules:
+    StmHamt.Hamt
+    StmHamt.SizedHamt
+  other-modules:
+    StmHamt.Accessors.Hash
+    StmHamt.Constructors.Branch
+    StmHamt.Constructors.Hash
+    StmHamt.Focuses
+    StmHamt.Prelude
+    StmHamt.Types
+    StmHamt.UnfoldMs
+  build-depends:
+    base >=4.6 && <5,
+    deferred-folds >=0.6.5 && <0.7,
+    focus >=1 && <1.1,
+    hashable <2,
+    primitive >=0.6.4 && <0.7,
+    primitive-extras >=0.5 && <0.6
+
+test-suite test
+  type:
+    exitcode-stdio-1.0
+  hs-source-dirs:
+    test
+  default-extensions:
+    Arrows, BangPatterns, BinaryLiterals, 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
+  main-is:
+    Main.hs
+  other-modules:
+    Main.Gens
+    Main.Transaction
+  build-depends:
+    deferred-folds,
+    focus,
+    QuickCheck >=2.8.1 && <3,
+    quickcheck-instances >=0.3.11 && <0.4,
+    rerebase <2,
+    stm-hamt,
+    tasty >=0.12 && <2,
+    tasty-hunit >=0.9 && <0.11,
+    tasty-quickcheck >=0.9 && <0.11
+
+benchmark concurrent-insertion-bench
+  type:
+    exitcode-stdio-1.0
+  hs-source-dirs:
+    concurrent-insertion-bench
+  default-extensions:
+    Arrows, BangPatterns, BinaryLiterals, 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
+  ghc-options:
+    -O2 -threaded "-with-rtsopts=-N"
+  main-is:
+    Main.hs
+  build-depends:
+    criterion ==1.5.*,
+    mwc-random >=0.13 && <0.15,
+    mwc-random-monad ==0.7.*,
+    -- data:
+    list-t,
+    focus,
+    stm-hamt,
+    -- general:
+    free >=4.5 && <6,
+    async >=2.0 && <3,
+    rebase <2
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,107 @@
+module Main where
+
+import Prelude
+import Test.Tasty
+import Test.Tasty.Runners
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck hiding ((.&.))
+import Test.QuickCheck.Instances
+import Test.QuickCheck hiding ((.&.))
+import Test.QuickCheck.Property hiding (testCase, (.&.))
+import StmHamt.Hamt (Hamt)
+import Main.Transaction (Transaction)
+import qualified Main.Transaction as Transaction
+import qualified Main.Gens as Gens
+import qualified StmHamt.Hamt as Hamt
+import qualified Data.HashMap.Strict as HashMap
+import qualified Focus
+import qualified DeferredFolds.UnfoldM as UnfoldM
+
+
+main =
+  defaultMain $
+  testGroup "All" $
+  [
+    testGroup "Hamt" $ let
+
+      hamtFromListUsingInsertWithHashInIo :: (Eq key, Eq value, Show (key, value)) => (key -> Int) -> [(key, value)] -> IO (Hamt (key, value))
+      hamtFromListUsingInsertWithHashInIo hash list = do
+        hamt <- Hamt.newIO
+        atomically $ forM_ list $ \ (key, value) -> Hamt.insertExplicitly (hash key) ((==) key . fst) (key, value) hamt
+        return hamt
+
+      hamtFromListUsingInsertInIo :: (Eq key, Hashable key, Eq value, Show (key, value)) => [(key, value)] -> IO (Hamt (key, value))
+      hamtFromListUsingInsertInIo list = do
+        hamt <- Hamt.newIO
+        atomically $ forM_ list $ \ pair -> Hamt.insert fst pair hamt
+        return hamt
+
+      hamtToListInIo :: Hamt a -> IO [a]
+      hamtToListInIo hamt =
+        fmap reverse $
+        atomically $
+        UnfoldM.foldlM' (\ state element -> return (element : state)) [] (Hamt.unfoldM hamt)
+
+      listToListThruHamtInIo :: [(Char, Int)] -> IO [(Char, Int)]
+      listToListThruHamtInIo = hamtFromListUsingInsertInIo >=> hamtToListInIo
+
+      testTransactionProperty :: String -> (Text -> Int) -> Gen Transaction -> TestTree
+      testTransactionProperty name hash transactionGen =
+        let
+          gen = (,) <$> transactionGen <*> Gens.keyValueList
+          in
+            testProperty ("Transaction: " <> name) $
+            forAll gen $ \ (Transaction.Transaction name applyToHashMap applyToStmHamt, list) -> let
+              (result1, hashMapList) = fmap (sort . HashMap.toList) (applyToHashMap (HashMap.fromList list))
+              (result2, hamtList) = unsafePerformIO $ do
+                hamt <- hamtFromListUsingInsertWithHashInIo hash list
+                result2 <- atomically $ applyToStmHamt hamt
+                list <- hamtToListInIo hamt
+                return (result2, sort list)
+              in
+                counterexample
+                  ("hashMapList: " <> show hashMapList <> "\nhamtList: " <> show hamtList <> "\nresult1: " <> show result1 <> "\nresult2: " <> show result2)
+                  (hashMapList == hamtList && result1 == result2)
+
+      in
+        [
+          testCase "insert" $ let
+            list =
+              [
+                ('a', 1),
+                ('b', 2),
+                ('c', 3),
+                ('d', 4)
+              ]
+            in do
+              hamtList <- listToListThruHamtInIo list
+              assertEqual (show hamtList) list hamtList
+          ,
+          testCase "insert with dup" $ let
+            list =
+              [
+                ('a', 1),
+                ('b', 1),
+                ('b', 2),
+                ('c', 3),
+                ('d', 4)
+              ]
+            in do
+              hamtList <- listToListThruHamtInIo list
+              assertEqual (show hamtList) (delete ('b', 1) list) hamtList
+          ,
+          testTransactionProperty "insert" hash Gens.insertTransaction
+          ,
+          let
+            newHash key = hash key .&. 0b111
+            in testTransactionProperty "Hash collision" newHash (Gens.insertWithHashTransaction newHash)
+          ,
+          testTransactionProperty "insertUsingFocus" hash Gens.insertUsingFocusTransaction
+          ,
+          testTransactionProperty "deleteUsingFocus" hash Gens.deleteUsingFocusTransaction
+          ,
+          testTransactionProperty "incrementUsingAdjustFocus" hash Gens.incrementUsingAdjustFocusTransaction
+          ,
+          testTransactionProperty "lookup" hash Gens.lookupTransaction
+        ]
+  ]
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,70 @@
+module Main.Gens where
+
+import Prelude hiding (choose)
+import Test.QuickCheck.Gen
+import StmHamt.Hamt (Hamt)
+import Focus (Focus(..))
+import Main.Transaction (Transaction)
+import qualified StmHamt.Hamt as StmHamt
+import qualified Data.HashMap.Strict as HashMap
+import qualified Main.Transaction as Transaction
+
+
+key :: Gen Text
+key = do
+  length <- frequency [(1, pure 0), (20, pure 1), (2, pure 2), (1, pure 3)]
+  chars <- vectorOf length (choose ('a', 'b'))
+  return (fromString chars)
+
+value :: Gen Int
+value = choose (0, 9)
+
+lookupTransaction :: Gen Transaction
+lookupTransaction = Transaction.lookup <$> key
+
+insertTransaction :: Gen Transaction
+insertTransaction = Transaction.insert <$> key <*> value
+
+insertWithHashTransaction :: (Text -> Int) -> Gen Transaction
+insertWithHashTransaction hash = do
+  keyValue <- key
+  valueValue <- value
+  let
+    !hashValue = hash keyValue
+    in return (Transaction.insertWithHash hashValue keyValue valueValue)
+
+insertUsingFocusTransaction :: Gen Transaction
+insertUsingFocusTransaction = Transaction.insertUsingFocus <$> key <*> value
+
+deleteUsingFocusTransaction :: Gen Transaction
+deleteUsingFocusTransaction = Transaction.deleteUsingFocus <$> key
+
+incrementUsingAdjustFocusTransaction :: Gen Transaction
+incrementUsingAdjustFocusTransaction = Transaction.incrementUsingAdjustFocus <$> key
+
+seriesOfModificationsTransaction :: Gen Transaction
+seriesOfModificationsTransaction = undefined
+
+transaction :: Gen Transaction
+transaction =
+  frequency
+    [
+      (9, lookupTransaction),
+      (2, insertTransaction),
+      (2, insertUsingFocusTransaction),
+      (9, deleteUsingFocusTransaction),
+      (9, incrementUsingAdjustFocusTransaction)
+    ]
+
+hamt :: Gen (STM (Hamt (Text, Int)))
+hamt = do
+  list <- keyValueList
+  return $ do
+    hamt <- StmHamt.new
+    forM_ list $ \ pair -> StmHamt.insert fst pair hamt
+    return hamt
+
+keyValueList :: Gen [(Text, Int)]
+keyValueList = do
+  size <- choose (0, 9)
+  replicateM size ((,) <$> key <*> value)
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,73 @@
+module Main.Transaction where
+
+import Prelude
+import StmHamt.Hamt (Hamt)
+import Focus (Focus(..))
+import qualified StmHamt.Hamt as StmHamt
+import qualified Data.HashMap.Strict as HashMap
+import qualified Focus
+import qualified Data.Text as Text
+
+
+data Transaction = forall result. (Show result, Eq result) => Transaction {
+  name :: Text,
+  applyToHashMap :: HashMap Text Int -> (result, HashMap Text Int),
+  applyToStmHamt :: Hamt (Text, Int) -> STM result
+}
+
+instance Show Transaction where
+  show = Text.unpack . name
+
+lookup :: Text -> Transaction
+lookup key = let
+  name = fromString ("lookup " <> show key)
+  applyToHashMap hashMap = (HashMap.lookup key hashMap, hashMap)
+  applyToStmHamt hamt = (fmap . fmap) snd (StmHamt.lookup fst key hamt)
+  in Transaction name applyToHashMap applyToStmHamt
+
+insert :: Text -> Int -> Transaction
+insert key value = let
+  name = fromString ("insert " <> show key <> " " <> show value)
+  applyToHashMap = ((),) . HashMap.insert key value
+  applyToStmHamt hamt = StmHamt.insert fst (key, value) hamt $> ()
+  in Transaction name applyToHashMap applyToStmHamt
+
+{-| A transaction which can be used to manipulate hash collision -}
+insertWithHash :: Int -> Text -> Int -> Transaction
+insertWithHash hash key value = let
+  name = fromString ("insert " <> show key <> " " <> show value)
+  applyToHashMap = ((),) . HashMap.insert key value
+  applyToStmHamt hamt = StmHamt.insertExplicitly hash ((==) key . fst) (key, value) hamt $> ()
+  in Transaction name applyToHashMap applyToStmHamt
+
+focus :: (forall m. Monad m => Focus Int m ()) -> Text -> Transaction
+focus focus@(Focus conceal reveal) key = let
+  name = "focus"
+  applyToHashMap hashMap = let
+    Identity (result, change) = case HashMap.lookup key hashMap of
+      Just existingValue -> reveal existingValue
+      Nothing -> conceal
+    newHashMap = case change of
+      Focus.Leave -> hashMap
+      Focus.Set newValue -> HashMap.insert key newValue hashMap
+      Focus.Remove -> HashMap.delete key hashMap
+    in (result, newHashMap)
+  applyToStmHamt = let
+    stmHamtFocus = Focus.mappingInput (key,) snd focus
+    in StmHamt.focus stmHamtFocus fst key
+  in Transaction name applyToHashMap applyToStmHamt
+
+insertUsingFocus :: Text -> Int -> Transaction
+insertUsingFocus key value = let
+  name = fromString ("insertUsingFocus " <> show key <> " " <> show value)
+  in (focus (Focus.insert value) key) { name = name }
+
+deleteUsingFocus :: Text -> Transaction
+deleteUsingFocus key = let
+  name = fromString ("deleteUsingFocus " <> show key)
+  in (focus Focus.delete key) { name = name }
+
+incrementUsingAdjustFocus :: Text -> Transaction
+incrementUsingAdjustFocus key = let
+  name = fromString ("incrementUsingAdjustFocus " <> show key)
+  in (focus (Focus.adjust succ) key) { name = name }