diff --git a/CurryDB.cabal b/CurryDB.cabal
--- a/CurryDB.cabal
+++ b/CurryDB.cabal
@@ -1,5 +1,5 @@
 name:                CurryDB
-version:             0.1.0.0
+version:             0.1.1.0
 synopsis:            CurryDB: In-memory Key/Value Database
 description:         CurryDB: Simple, Persistent, Polymorphic, Transactional, In-memory Key/Value Database
 license:             BSD3
@@ -19,6 +19,7 @@
   exposed-modules:   Database.Curry
                      Database.Curry.Binary
                      Database.Curry.Commands
+                     Database.Curry.HashMap
                      Database.Curry.Storage
                      Database.Curry.Types
                      Database.Memcached
@@ -38,9 +39,7 @@
                    , transformers-base >=0.4
                    , unordered-containers >=0.2.2
                    , containers >=0.4
-                   , data-lens >= 2.10
-                   , data-lens-fd >= 2.0
-                   , data-lens-template >= 2.1
+                   , lens >=3.6
                    , conduit >=0.5
                    , time
                    , stm >=2.4
@@ -59,8 +58,10 @@
                    , system-filepath >=0.4.7
                    , system-fileio >=0.3.10
                    , async >=2.0
-                   , binary >=0.6.1
+                   , binary >=0.5
                    , lifted-base >=0.2
+                   , hashable
+                   , array
 
   ghc-prof-options:  -auto-all
 
@@ -79,7 +80,7 @@
                      , network-conduit
                      , system-filepath
                      , optparse-applicative
-                     , ekg >=0.3.1
+--                      , ekg >=0.3.1
                      , CurryDB
 
 test-suite doctests
@@ -100,6 +101,7 @@
                      , mtl
                      , stm
                      , conduit
+                     , lifted-base
                      , CurryDB
 
 benchmark curry-bench
diff --git a/Database/Curry.hs b/Database/Curry.hs
--- a/Database/Curry.hs
+++ b/Database/Curry.hs
@@ -19,19 +19,18 @@
 import           Control.Monad.Trans.Identity
 import           Data.Binary
 import           Data.Default
-import qualified Data.HashMap.Strict          as HMS
 import           System.IO
 import           System.Log.FastLogger
 
-import           Database.Curry.Binary        ()
 import           Database.Curry.Commands
+import qualified Database.Curry.HashMap as HM
 import           Database.Curry.Storage
 import           Database.Curry.Types
 
 initDBMState :: Config -> STM () -> IO (DBMState v)
 initDBMState conf upd =
   DBMState
-    <$> newTVarIO HMS.empty
+    <$> HM.new
     <*> pure upd
     <*> mkLogger True stdout
     <*> pure conf
diff --git a/Database/Curry/Commands.hs b/Database/Curry/Commands.hs
--- a/Database/Curry/Commands.hs
+++ b/Database/Curry/Commands.hs
@@ -5,7 +5,7 @@
   insert,
   insertWith,
   delete,
-  Database.Curry.Commands.lookup,
+  lookup,
   lookupDefault,
   keys,
 
@@ -15,59 +15,56 @@
 
 import           Control.Applicative
 import           Control.Concurrent.STM
+import           Control.Lens
 import           Control.Monad.State.Strict
 import           Control.Monad.Trans.Identity
 import qualified Data.ByteString              as S
 import           Data.Conduit
 import           Data.Default
-import qualified Data.HashMap.Strict          as HMS
-import           Data.Lens
 import           Data.Maybe
 
+import qualified Database.Curry.HashMap       as HM
 import           Database.Curry.Types
 
+import           Prelude                      hiding (lookup)
+
 insert :: S.ByteString -> v -> DBMS v ()
 insert !key !val = do
-  table <- access dbmTable
-  liftSTM $ modifyTVar' table $ HMS.insert key val
+  liftSTM . HM.insert key val =<< use dbmTable
   update
 {-# INLINE insert #-}
 
 insertWith :: (v -> v -> v) -> S.ByteString -> v -> DBMS v ()
 insertWith !f !key !val = do
-  htvar <- access dbmTable
-  liftSTM $ modifyTVar' htvar $ HMS.insertWith f key val
+  liftSTM . HM.insertWith f key val =<< use dbmTable
   update
 {-# INLINE insertWith #-}
 
 delete :: S.ByteString -> DBMS v ()
 delete !key = do
-  htvar <- access dbmTable
-  liftSTM $ modifyTVar' htvar $ HMS.delete key
+  liftSTM . HM.delete key =<< use dbmTable
   update
 {-# INLINE delete #-}
 
 lookup :: S.ByteString -> DBMS v (Maybe v)
 lookup !key = do
-  htvar <- access dbmTable
-  liftSTM $ HMS.lookup key <$> readTVar htvar
+  ht <- use dbmTable
+  liftSTM $ HM.lookup key ht
 {-# INLINE lookup #-}
 
 lookupDefault :: Default v => S.ByteString -> DBMS v v
-lookupDefault !key = do
-  htvar <- access dbmTable
-  liftSTM $ fromMaybe def . HMS.lookup key <$> readTVar htvar
+lookupDefault !key = fromMaybe def <$> lookup key
 {-# INLINE lookupDefault #-}
 
 keys :: Monad m => DBMS v (Source (DBMT v m) S.ByteString)
 keys = do
-  htvar <- access dbmTable
-  ht <- liftSTM $ readTVar htvar
-  return $ mapM_ yield $ HMS.keys ht
+  ht <- use dbmTable
+  ks <- liftSTM $ HM.keys ht
+  return $ mapM_ yield ks
 {-# INLINE keys #-}
 
 update ::DBMS v ()
-update = liftSTM =<< access dbmUpdate
+update = liftSTM =<< use dbmUpdate
 {-# INLINE update #-}
 
 transaction :: MonadIO m => DBMS v a -> DBMT v m a
diff --git a/Database/Curry/HashMap.hs b/Database/Curry/HashMap.hs
new file mode 100644
--- /dev/null
+++ b/Database/Curry/HashMap.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Curry.HashMap (
+  HashMap, Key,
+  new,
+  load, save,
+  insert, insertWith,
+  delete,
+  lookup,
+  keys,
+  ) where
+
+import           Control.Applicative
+import           Control.Concurrent.STM
+import qualified Control.Exception      as E
+import           Control.Monad
+import qualified Data.Array.MArray      as MA
+import           Data.Binary
+import qualified Data.ByteString        as S
+import qualified Data.ByteString.Lazy   as L
+import           Data.Hashable
+import qualified Data.HashMap.Strict    as HMS
+import           Data.Maybe
+import qualified Filesystem             as FS
+import qualified Filesystem.Path        as FP
+import           System.IO
+
+import           Database.Curry.Binary  ()
+
+import           Prelude                hiding (lookup)
+
+type Key = S.ByteString
+
+newtype HashMap v =
+  HashMap { unHM :: TArray Int (HMS.HashMap Key v) }
+
+bucketNum :: Int
+bucketNum = 32
+
+bucketIx :: Key -> Int
+bucketIx key = hash key `mod` bucketNum
+
+new :: IO (HashMap v)
+new = atomically $ do
+  HashMap <$> MA.newArray (0, bucketNum - 1) HMS.empty
+
+load :: Binary v => FP.FilePath -> HashMap v -> IO ()
+load path hm = do
+  vs <- decode . L.fromChunks . (\x -> [x]) <$> FS.readFile path
+  _ <- E.evaluate vs -- force and raise exception when data is corrupted.
+  when (length vs /= bucketNum) $
+    fail "load: data corrupted"
+  atomically $ do
+    forM_ (zip [0..] vs) $ \(ix, v) -> do
+      MA.writeArray (unHM hm) ix v
+
+save :: Binary v => FP.FilePath -> HashMap v -> IO ()
+save path hm = do
+  vs <- atomically $ forM_ [0 .. bucketNum - 1] $ \ix -> MA.readArray (unHM hm) ix
+  atomicWriteFile path vs
+
+insert :: Key -> v -> HashMap v -> STM ()
+insert = insertWith const
+{-# INLINE insert #-}
+
+insertWith :: (v -> v -> v) -> Key -> v -> HashMap v -> STM ()
+insertWith f k v hm = do
+  let bix = bucketIx k
+  bkt <- MA.readArray (unHM hm) bix
+  MA.writeArray (unHM hm) bix $! HMS.insertWith f k v bkt
+{-# INLINE insertWith #-}
+
+delete :: Key -> HashMap v -> STM ()
+delete k hm = do
+  let bix = bucketIx k
+  bkt <- MA.readArray (unHM hm) bix
+  MA.writeArray (unHM hm) bix $! HMS.delete k bkt
+{-# INLINE delete #-}
+
+lookup :: Key -> HashMap v -> STM (Maybe v)
+lookup k hm = do
+  let bix = bucketIx k
+  HMS.lookup k <$> MA.readArray (unHM hm) bix
+{-# INLINE lookup #-}
+
+keys :: HashMap v -> STM [Key]
+keys hm = do
+  bkts <- forM [0 .. bucketNum - 1] $ \ix ->
+    HMS.keys <$> MA.readArray (unHM hm) ix
+  return $ concat bkts
+{-# INLINE keys #-}
+
+--
+
+atomicWriteFile :: Binary b => FP.FilePath -> b -> IO ()
+atomicWriteFile path b = do
+  let tmpPath = path FP.<.> "tmp"
+  FS.withFile tmpPath WriteMode $ \h ->
+    L.hPut h $ encode b
+  -- rename operation is atomic
+  FS.rename tmpPath path
diff --git a/Database/Curry/Storage.hs b/Database/Curry/Storage.hs
--- a/Database/Curry/Storage.hs
+++ b/Database/Curry/Storage.hs
@@ -10,24 +10,19 @@
   loadFromFile,
   ) where
 
-import           Control.Applicative
 import           Control.Concurrent         (forkIO, threadDelay)
 import           Control.Concurrent.Async
 import           Control.Concurrent.STM
 import qualified Control.Exception          as E
+import           Control.Lens
 import           Control.Monad.Logger
 import           Control.Monad.State.Strict
 import           Data.Binary
-import qualified Data.ByteString.Lazy       as L
-import           Data.Lens
 import           Data.Monoid
 import qualified Data.Text                  as T
 import           Data.Time
-import qualified Filesystem                 as FS
-import qualified Filesystem.Path.CurrentOS  as FP
-import           System.IO
 
-import           Database.Curry.Binary      ()
+import           Database.Curry.HashMap     as HM
 import           Database.Curry.Types
 
 saveThread :: (Functor m, MonadIO m, Binary v)
@@ -47,7 +42,7 @@
 
   let notify (SaveByFrequency {..})= do
         upd <- newTVarIO 0
-        forkIO $ forever $ do
+        _ <- forkIO $ forever $ do
           start <- readTVarIO timer
           atomically $ do
             cur <- readTVar timer
@@ -74,13 +69,12 @@
 
 saveToFile :: (MonadIO m, Binary v) => DBMT v m ()
 saveToFile = do
-  Config {..} <- access dbmConfig
+  Config {..} <- use dbmConfig
   case configPath of
     Nothing -> return ()
-    Just fname -> do
+    Just path -> do
       $logInfo "save to file..."
-      tbl <- liftIO . readTVarIO =<< access dbmTable
-      err <- liftIO $ E.try $ atomicWriteFile fname tbl
+      err <- liftIO . E.try . HM.save path =<< use dbmTable
       case err of
         Right _ ->
           return ()
@@ -89,25 +83,14 @@
 
 loadFromFile :: (MonadIO m, Binary v) => DBMT v m ()
 loadFromFile = do
-  Config {..} <- access dbmConfig
+  Config {..} <- use dbmConfig
   case configPath of
     Nothing -> return ()
     Just path -> do
       $logInfo "load from file..."
-      etbl <- liftIO $ E.try $ do
-        v <- decode . L.fromChunks . (\x -> [x]) <$> FS.readFile path
-        E.evaluate v -- force and raise exception when data is corrupted.
-      case etbl of
-        Right tbl -> do
-          tv <- access dbmTable
-          liftIO $ atomically $ writeTVar tv tbl
+      tbl <- use dbmTable
+      res <- liftIO . E.try . HM.load path =<< use dbmTable
+      case res of
+        Right () -> return ()
         Left err -> do
           $logInfo $ "fail to load " <> ": " <> (T.pack $ show (err :: E.SomeException))
-
-atomicWriteFile :: Binary b => FP.FilePath -> b -> IO ()
-atomicWriteFile path b = do
-  let tmpPath = path FP.<.> "tmp"
-  FS.withFile tmpPath WriteMode $ \h ->
-    L.hPut h $ encode b
-  -- rename operation is atomic
-  FS.rename tmpPath path
diff --git a/Database/Curry/Types.hs b/Database/Curry/Types.hs
--- a/Database/Curry/Types.hs
+++ b/Database/Curry/Types.hs
@@ -27,22 +27,20 @@
 
 import           Control.Applicative
 import           Control.Concurrent.STM
+import           Control.Lens
 import           Control.Monad
 import           Control.Monad.Base
 import           Control.Monad.Logger
 import           Control.Monad.State.Strict
 import           Control.Monad.Trans.Control
 import           Control.Monad.Trans.Identity
-import qualified Data.ByteString              as S
 import           Data.Conduit
 import           Data.Default
-import qualified Data.HashMap.Strict          as HMS
-import           Data.Lens.Template
 import qualified Filesystem.Path.CurrentOS    as FP
 import           Language.Haskell.TH.Syntax   (Loc (..))
 import           System.Log.FastLogger
 
-import           Database.Curry.Binary        ()
+import           Database.Curry.HashMap
 
 type DBMT v m = DBMT_ (StateT (DBMState v) m)
 type DBMS v = DBMT v STM
@@ -86,7 +84,7 @@
 
 data DBMState v
   = DBMState
-    { _dbmTable  :: TVar (HMS.HashMap S.ByteString v)
+    { _dbmTable  :: HashMap v
     , _dbmUpdate :: STM ()
     , _dbmLogger :: Logger
     , _dbmConfig :: Config
@@ -105,7 +103,7 @@
     , freqUpdates :: Int
     }
 
-makeLens ''DBMState
+makeLenses ''DBMState
 
 instance Default Config where
   def = Config
diff --git a/tests/hspec.hs b/tests/hspec.hs
--- a/tests/hspec.hs
+++ b/tests/hspec.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import           Control.Applicative
+import           Control.Concurrent.Chan.Lifted
+import           Control.Concurrent.Lifted
 import           Control.Monad
 import           Control.Monad.Trans
 import           Data.Conduit
-import qualified Data.Conduit.List   as CL
-import           Data.List (sort)
+import qualified Data.Conduit.List              as CL
+import           Data.List                      (sort)
 
 import           Test.Hspec
 -- import Test.QuickCheck
@@ -13,7 +15,7 @@
 
 import           Database.Curry
 
-import           Prelude             hiding (lookup)
+import           Prelude                        hiding (lookup)
 
 main :: IO ()
 main = hspec $ do
@@ -107,4 +109,17 @@
         liftIO $ v2 `shouldBe` Just 456
         v3 <- transaction $ lookup "baz"
         liftIO $ v3 `shouldBe` Nothing
+      return () :: IO ()
+
+  describe "concurrent support" $ do
+    it "does not race" $ do
+      runDBMT def $ do
+        chan <- newChan
+        replicateM_ 10 $ fork $ do
+          replicateM_ 10000 $ do
+            transaction $ insertWith (+) "foo" (1 :: Int)
+          writeChan chan ()
+        replicateM_ 10 $ readChan chan
+        cnt <- transaction $ lookupDefault "foo"
+        liftIO $ cnt `shouldBe` 100000
       return () :: IO ()