diff --git a/Control/Concurrent/Map.hs b/Control/Concurrent/Map.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/Map.hs
@@ -0,0 +1,389 @@
+{-# LANGUAGE BangPatterns, PatternGuards, MagicHash #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+-----------------------------------------------------------------------
+-- | A non-blocking concurrent map from hashable keys to values.
+--
+-- The implementation is based on /lock-free concurrent hash tries/
+-- (aka /Ctries/) as described by:
+--
+--    * Aleksander Prokopec, Phil Bagwell, Martin Odersky,
+--      \"/Cache-Aware Lock-Free Concurent Hash Tries/\"
+--
+--    * Aleksander Prokopec, Nathan G. Bronson, Phil Bagwell,
+--      Martin Odersky \"/Concurrent Tries with Efficient Non-Blocking
+--      Snapshots/\"
+--
+-- Operations have a worst-case complexity of /O(log n)/, with a base
+-- equal to the size of the native 'Word'.
+--
+-----------------------------------------------------------------------
+
+-- [Note: CAS and pointer equality]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- For the atomic compare-and-swap, we need to be able to compare two
+-- CNode objects. We can't do an actual '==' comparison, as that would
+-- entail traversing the whole subtree. We could add a 'Unique' to the
+-- CNode and compare on that, but we don't want the overhead.
+--
+-- The only remaining option is pointer equality. The "proper" way would
+-- be to use 'StableName' (although we'd need 'unsafePerformIO' to use it
+-- inside 'atomicModifyIORef') but GHC's 'reallyUnsafePtrEquality#' is
+-- more than twice as fast and, despite the scary name, seems to be
+-- perfectly safe to use (unordered-containers uses it, for example).
+--
+-- If portability is a concern, we can always #ifdef the relevant section.
+
+module Control.Concurrent.Map
+    ( Map
+
+      -- * Construction
+    , empty
+
+      -- * Modification
+    , insert
+    , delete
+
+      -- * Query
+    , lookup
+
+      -- * Lists
+    , fromList
+    , unsafeToList
+
+    --, printMap
+    ) where
+
+import Control.Applicative ((<$>))
+import Control.Monad
+import Data.Bits
+import Data.Hashable (Hashable)
+import qualified Data.Hashable as H
+import Data.IORef
+import qualified Data.List as List
+import Data.Maybe
+import Data.Word
+import GHC.Exts ((==#), reallyUnsafePtrEquality#)
+import Prelude hiding (lookup)
+
+import qualified Control.Concurrent.Map.Array as A
+
+-----------------------------------------------------------------------
+
+-- | A map from keys @k@ to values @v@.
+newtype Map k v = Map (INode k v)
+
+type INode k v = IORef (MainNode k v)
+
+data MainNode k v = CNode !Bitmap !(A.Array (Branch k v))
+                  | Tomb !(SNode k v)
+                  | Collision ![SNode k v]
+
+data Branch k v = INode !(INode k v)
+                | SNode !(SNode k v)
+
+data SNode k v = S !k v
+    deriving (Eq, Show)
+
+isTomb :: MainNode k v -> Bool
+isTomb (Tomb _) = True
+isTomb _        = False
+
+type Bitmap = Word
+type Hash   = Word
+type Level  = Int
+
+hash :: Hashable a => a -> Hash
+hash = fromIntegral . H.hash
+
+
+-----------------------------------------------------------------------
+-- * Construction
+
+-- | /O(1)/. Construct an empty map.
+empty :: IO (Map k v)
+empty = Map <$> newIORef (CNode 0 A.empty)
+
+
+-----------------------------------------------------------------------
+-- * Modification
+
+-- | /O(log n)/. Associate the given value with the given key.
+-- If the key is already present in the map, the old value is replaced.
+insert :: (Eq k, Hashable k) => k -> v -> Map k v -> IO ()
+insert k v (Map root) = go0
+    where
+        h = hash k
+        go0 = go 0 undefined root
+        go lev parent inode = do
+            main <- readIORef inode
+            case main of
+                cn@(CNode bmp arr) -> do
+                    let m = mask h lev
+                        i = sparseIndex bmp m
+                        n = popCount bmp
+                    if bmp .&. m == 0
+                        then do
+                            let arr' = A.insert (SNode (S k v)) i n arr
+                                cn'  = CNode (bmp .|. m) arr'
+                            unlessM (compareAndSwap inode cn cn') go0
+
+                        else case A.index arr i of
+                            SNode (S k2 v2)
+                                | k == k2 -> do
+                                    let arr' = A.update (SNode (S k v)) i n arr
+                                        cn'  = CNode bmp arr'
+                                    unlessM (compareAndSwap inode cn cn') go0
+
+                                | otherwise -> do
+                                    let h2 = hash k2
+                                    inode2 <- newINode h k v h2 k2 v2 (nextLevel lev)
+                                    let arr' = A.update (INode inode2) i n arr
+                                        cn'  = CNode bmp arr'
+                                    unlessM (compareAndSwap inode cn cn') go0
+
+                            INode inode2 -> go (nextLevel lev) inode inode2
+
+                Tomb _ -> clean parent (prevLevel lev) >> go0
+
+                col@(Collision arr) -> do
+                    let arr' = S k v : filter (\(S k2 _) -> k2 /= k) arr
+                        col' = Collision arr'
+                    unlessM (compareAndSwap inode col col') go0
+
+{-# INLINABLE insert #-}
+
+newINode :: Hash -> k -> v -> Hash -> k -> v -> Int -> IO (INode k v)
+newINode h1 k1 v1 h2 k2 v2 lev
+    | lev >= hashLength = newIORef $ Collision [S k1 v1, S k2 v2]
+    | otherwise = do
+        let i1 = index h1 lev
+            i2 = index h2 lev
+            bmp = (unsafeShiftL 1 i1) .|. (unsafeShiftL 1 i2)
+        case compare i1 i2 of
+            LT -> newIORef $ CNode bmp $ A.pair (SNode (S k1 v1)) (SNode (S k2 v2))
+            GT -> newIORef $ CNode bmp $ A.pair (SNode (S k2 v2)) (SNode (S k1 v1))
+            EQ -> do inode' <- newINode h1 k1 v1 h2 k2 v2 (nextLevel lev)
+                     newIORef $ CNode bmp $ A.singleton (INode inode')
+
+
+-- | /O(log n)/. Remove the given key and its associated value from the map,
+-- if present.
+delete :: (Eq k, Hashable k) => k -> Map k v -> IO ()
+delete k (Map root) = go0
+    where
+        h = hash k
+        go0 = go 0 undefined root
+        go lev parent inode = do
+            main <- readIORef inode
+            case main of
+                cn@(CNode bmp arr) -> do
+                    let m = mask h lev
+                        i = sparseIndex bmp m
+                    if bmp .&. m == 0
+                        then return ()  -- not found
+                        else case A.index arr i of
+                            SNode (S k2 _)
+                                | k == k2 -> do
+                                    let arr' = A.delete i (popCount bmp) arr
+                                        cn'  = CNode (bmp `xor` m) arr'
+                                        cn'' = contract lev cn'
+                                    unlessM (compareAndSwap inode cn cn'') go0
+                                    whenM (isTomb <$> readIORef inode) $
+                                        cleanParent parent inode h (prevLevel lev)
+
+                                | otherwise -> return ()  -- not found
+
+                            INode inode2 -> go (nextLevel lev) inode inode2
+
+                Tomb _ -> clean parent (prevLevel lev) >> go0
+
+                col@(Collision arr) -> do
+                    let arr' = filter (\(S k2 _) -> k2 /= k) $ arr
+                        col' | [s] <- arr' = Tomb s
+                             | otherwise   = Collision arr'
+                    unlessM (compareAndSwap inode col col') go0
+
+{-# INLINABLE delete #-}
+
+-----------------------------------------------------------------------
+-- * Query
+
+-- | /O(log n)/. Return the value associated with the given key, or 'Nothing'.
+lookup :: (Eq k, Hashable k) => k -> Map k v -> IO (Maybe v)
+lookup k (Map root) = go0
+    where
+        h = hash k
+        go0 = go 0 undefined root
+        go lev parent inode = do
+            main <- readIORef inode
+            case main of
+                CNode bmp arr -> do
+                    let m = mask h lev
+                        i = sparseIndex bmp m
+                    if bmp .&. m == 0
+                        then return Nothing
+                        else case A.index arr i of
+                            INode inode2 -> go (nextLevel lev) inode inode2
+                            SNode (S k2 v) | k == k2   -> return (Just v)
+                                           | otherwise -> return Nothing
+
+                Tomb _ -> clean parent (prevLevel lev) >> go0
+
+                Collision xs -> do
+                    case List.find (\(S k2 _) -> k2 == k) xs of
+                        Just (S _ v) -> return (Just v)
+                        _            -> return Nothing
+
+{-# INLINABLE lookup #-}
+
+-----------------------------------------------------------------------
+-- * Internal compression operations
+
+clean :: INode k v -> Level -> IO ()
+clean inode lev = do
+    main <- readIORef inode
+    case main of
+        cn@(CNode _ _) -> do
+            cn' <- compress lev cn
+            void $ compareAndSwap inode cn cn'
+        _ -> return ()
+{-# INLINE clean #-}
+
+cleanParent :: INode k v -> INode k v -> Hash -> Level -> IO ()
+cleanParent parent inode h lev = do
+    pmain <- readIORef parent
+    case pmain of
+        cn@(CNode bmp arr) -> do
+            let m = mask h lev
+                i = sparseIndex bmp m
+            unless (bmp .&. m == 0) $
+                case A.index arr i of
+                    INode inode2 | inode2 == inode ->
+                        whenM (isTomb <$> readIORef inode) $ do
+                            cn' <- compress lev cn
+                            unlessM (compareAndSwap parent cn cn') $
+                                cleanParent parent inode h lev
+                    _ -> return ()
+        _ -> return ()
+
+compress :: Level -> MainNode k v -> IO (MainNode k v)
+compress lev (CNode bmp arr) =
+    contract lev <$> CNode bmp <$> A.mapM resurrect (popCount bmp) arr
+compress _ x = return x
+{-# INLINE compress #-}
+
+resurrect :: Branch k v -> IO (Branch k v)
+resurrect b@(INode inode) = do
+    main <- readIORef inode
+    case main of
+        Tomb s -> return (SNode s)
+        _      -> return b
+resurrect b = return b
+{-# INLINE resurrect #-}
+
+contract :: Level -> MainNode k v -> MainNode k v
+contract lev (CNode bmp arr) | lev > 0
+                           , popCount bmp == 1
+                           , SNode s <- A.head arr
+                           = Tomb s
+contract _ x = x
+{-# INLINE contract #-}
+
+-----------------------------------------------------------------------
+-- * Lists
+
+-- | /O(n * log n)/. Construct a map from a list of key/value pairs.
+fromList :: (Eq k, Hashable k) => [(k,v)] -> IO (Map k v)
+fromList xs = empty >>= \m -> mapM_ (\(k,v) -> insert k v m) xs >> return m
+{-# INLINABLE fromList #-}
+
+-- | /O(n)/. Unsafely convert the map to a list of key/value pairs.
+--
+-- WARNING: 'unsafeToList' makes no atomicity guarantees. Concurrent
+-- changes to the map will lead to inconsistent results.
+unsafeToList :: Map k v -> IO [(k,v)]
+unsafeToList (Map root) = go root
+    where
+        go inode = do
+            main <- readIORef inode
+            case main of
+                CNode bmp arr -> A.foldM' go2 [] (popCount bmp) arr
+                Tomb (S k v) -> return [(k,v)]
+                Collision xs -> return $ map (\(S k v) -> (k,v)) xs
+
+        go2 xs (INode inode) = go inode >>= \ys -> return (ys ++ xs)
+        go2 xs (SNode (S k v)) = return $ (k,v) : xs
+{-# INLINABLE unsafeToList #-}
+
+-----------------------------------------------------------------------
+
+-- see [Note: CAS and pointer equality]
+compareAndSwap :: IORef a -> a -> a -> IO Bool
+compareAndSwap ref old new =
+    atomicModifyIORef' ref (\cur -> if cur `ptrEq` old
+                                    then (new, True)
+                                    else (cur, False))
+{-# INLINE compareAndSwap #-}
+
+ptrEq :: a -> a -> Bool
+ptrEq !x !y = reallyUnsafePtrEquality# x y ==# 1#
+{-# INLINE ptrEq #-}
+
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM p s = p >>= \t -> if t then s else return ()
+{-# INLINE whenM #-}
+
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM p s = p >>= \t -> if t then return () else s
+{-# INLINE unlessM #-}
+
+-----------------------------------------------------------------------
+
+hashLength :: Int
+hashLength = bitSize (undefined :: Word)
+
+bitsPerSubkey :: Int
+bitsPerSubkey = floor . logBase (2 :: Float) . fromIntegral $ hashLength
+
+subkeyMask :: Bitmap
+subkeyMask = 1 `unsafeShiftL` bitsPerSubkey - 1
+
+index :: Hash -> Level -> Int
+index h lev = fromIntegral $ (h `unsafeShiftR` lev) .&. subkeyMask
+{-# INLINE index #-}
+
+-- when or-ed with a CNode bitmap, determines if the hash is present
+-- in the array at the given level of the trie
+mask :: Hash -> Level -> Bitmap
+mask h lev = 1 `unsafeShiftL` index h lev
+{-# INLINE mask #-}
+
+-- position in the CNode array
+sparseIndex :: Bitmap -> Bitmap -> Int
+sparseIndex bmp m = popCount ((m - 1) .&. bmp)
+{-# INLINE sparseIndex #-}
+
+nextLevel :: Level -> Level
+nextLevel = (+) bitsPerSubkey
+{-# INLINE nextLevel #-}
+
+prevLevel :: Level -> Level
+prevLevel = subtract bitsPerSubkey
+{-# INLINE prevLevel #-}
+
+-----------------------------------------------------------------------
+
+-- TODO
+--printMap :: (Show k, Show v) => Map k v -> IO ()
+--printMap (Map root) = goI root
+--    where
+--        goI inode = putStr "(I " >> readIORef inode >>= goM >> putStr ")\n"
+--        goM (CNode bmp arr) = do
+--            putStr $ "(C " ++ (show bmp) ++ " ["
+--            A.mapM_ (\b -> goB b >> putStr ", ") (popCount bmp) arr
+--            putStr $ "] )"
+--        goM (Tomb (S k v)) = putStr $ "(T " ++ (show k) ++ " " ++ (show v) ++ ")"
+--        goM (Collision xs) = putStr $ "(Collision " ++ show xs ++ ")"
+--        goB (INode i) = putStr "\n" >> goI i
+--        goB (SNode (S k v)) = putStr $ "(" ++ (show k) ++ "," ++ (show v) ++ ")"
diff --git a/Control/Concurrent/Map/Array.hs b/Control/Concurrent/Map/Array.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/Map/Array.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- | Convenient interface for 'Data.Primitive.Array'.
+module Control.Concurrent.Map.Array
+    ( Array
+    , empty, singleton, pair
+    , head, index
+    , insert, update, delete
+    , mapM, mapM_, foldM'
+    ) where
+
+import Control.Monad.Primitive
+import Control.Monad.ST
+import Data.Primitive.Array
+import Prelude hiding (head, mapM, mapM_)
+
+-----------------------------------------------------------------------
+
+empty :: Array a
+empty = runST $ unsafeFreezeArray =<< newArray 0 undefined
+{-# INLINE empty #-}
+
+singleton :: a -> Array a
+singleton x = runST $ do
+    marr <- newArray 1 x
+    unsafeFreezeArray marr
+{-# INLINE singleton #-}
+
+pair :: a -> a -> Array a
+pair x y = runST $ do
+    marr <- newArray 2 undefined
+    writeArray marr 0 x
+    writeArray marr 1 y
+    unsafeFreezeArray marr
+{-# INLINE pair #-}
+
+-----------------------------------------------------------------------
+
+head :: Array a -> a
+head = flip indexArray 0
+{-# INLINE head #-}
+
+index :: Array a -> Int -> a
+index = indexArray
+{-# INLINE index #-}
+
+-----------------------------------------------------------------------
+
+insert :: a -> Int -> Int -> Array a -> Array a
+insert x i n arr = runST $ do
+    marr <- newArray (n+1) undefined
+    copyArray marr 0 arr 0 i
+    writeArray marr i x
+    copyArray marr (i+1) arr i (n-i)
+    unsafeFreezeArray marr
+{-# INLINE insert #-}
+
+update :: a -> Int -> Int -> Array a -> Array a
+update x i n arr = runST $ do
+    marr <- newArray n undefined
+    copyArray marr 0 arr 0 n
+    writeArray marr i x
+    unsafeFreezeArray marr
+{-# INLINE update #-}
+
+delete :: Int -> Int -> Array a -> Array a
+delete i n arr = runST $ do
+    marr <- newArray (n-1) undefined
+    copyArray marr 0 arr 0 i
+    copyArray marr i arr (i+1) (n-(i+1))
+    unsafeFreezeArray marr
+{-# INLINE delete #-}
+
+-----------------------------------------------------------------------
+
+mapM :: PrimMonad m => (a -> m b) -> Int -> Array a -> m (Array b)
+mapM f = \n arr -> do
+    marr <- newArray n undefined
+    go n arr marr 0
+    unsafeFreezeArray marr
+    where
+        go n arr marr i
+            | i >= n = return ()
+            | otherwise = do
+                x <- indexArrayM arr i
+                writeArray marr i =<< f x
+                go n arr marr (i+1)
+{-# INLINE mapM #-}
+
+mapM_ :: PrimMonad m => (a -> m b) -> Int -> Array a -> m ()
+mapM_ f = \n arr -> go n arr 0
+    where
+        go n arr i
+            | i >= n = return ()
+            | otherwise = do
+                x <- indexArrayM arr i
+                _ <- f x
+                go n arr (i+1)
+{-# INLINE mapM_ #-}
+
+foldM' :: PrimMonad m => (b -> a -> m b) -> b -> Int -> Array a -> m b
+foldM' f z0 = \n arr -> go n arr 0 z0
+    where
+        go n arr i !z
+            | i >= n = return z
+            | otherwise = do
+                x <- indexArrayM arr i
+                go n arr (i+1) =<< f z x
+{-# INLINE foldM' #-}
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+
+The MIT License (MIT)
+
+Copyright (c) 2013 Michael Schröder
+
+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/benchmarks/Concurrent.hs b/benchmarks/Concurrent.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Concurrent.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import Control.Applicative ((<$>))
+import Control.Concurrent.Async
+import Control.Concurrent.MVar
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Criterion.Main
+import Criterion.Config
+import Data.Hashable
+import Data.List (foldl')
+import Data.Foldable (foldlM)
+import Data.Maybe
+import System.Random
+import System.Random.Shuffle
+import System.IO.Unsafe
+
+import qualified Control.Concurrent.Map as CM
+import qualified Data.Map as M
+import qualified Data.IntMap as IM
+import qualified Data.HashMap.Strict as HM
+
+main :: IO ()
+main = do
+    let hmS = HM.fromList elemsS :: HM.HashMap String Int
+    hmS_mvar <- newMVar hmS
+    let hmS_ops241_8     = hmOps hmS_mvar elemsS 8 n      (2,4,1)
+    let hmS_ops621_n10_8 = hmOps hmS_mvar elemsS 8 (n*10) (6,2,1)
+
+    cmS <- CM.fromList elemsS :: IO (CM.Map String Int)
+    let cmS_ops241_8     = cmOps cmS elemsS 8 n      (2,4,1)
+    let cmS_ops621_n10_8 = cmOps cmS elemsS 8 (n*10) (6,2,1)
+
+    putStrLn $ "n=" ++ show n
+
+    defaultMainWith defaultConfig
+        (liftIO $ do
+            evaluate $ rnf hmS
+            evaluate $ sum $ map length hmS_ops241_8
+            evaluate $ sum $ map length hmS_ops621_n10_8
+            evaluate $ rnf $ unsafePerformIO $ CM.unsafeToList cmS
+            evaluate $ sum $ map length cmS_ops241_8
+            evaluate $ sum $ map length cmS_ops621_n10_8
+            return ()
+        )
+        [
+            bgroup "Data.HashMap (MVar)"
+            [ bgroup "String"
+                [ bench "8 threads, n, 2:4:1"   $ runAll hmS_ops241_8
+                , bench "8 threads, 10n, 6:2:1" $ runAll hmS_ops621_n10_8
+                ]
+            ]
+            ,
+            bgroup "Control.Concurrent.Map"
+            [ bgroup "String"
+                [ bench "8 threads, n, 2:4:1"   $ runAll cmS_ops241_8
+                , bench "8 threads, 10n, 6:2:1" $ runAll cmS_ops621_n10_8
+                ]
+            ]
+        ]
+    where
+        n = 2^12
+        elemsS = zip keysS [1..n]
+        elemsI = zip keysI [1..n]
+        keysS = rndS 8 n
+        keysI = rndI (n+n) n
+
+
+rndS :: Int -> Int -> [String]
+rndS strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 1234
+    where
+        split cs = case splitAt strlen cs of (str, cs') -> str : split cs'
+
+rndI :: Int -> Int -> [Int]
+rndI upper num = take num $ randomRs (0, upper) $ mkStdGen 1234
+
+
+runAll :: [[IO ()]] -> IO ()
+runAll ops = do
+    as <- mapM (async . sequence_) ops
+    mapM_ wait as
+
+
+mkOps :: (k -> m -> IO ())       -- lookup function
+      -> (k -> v -> m -> IO ())  -- insert function
+      -> (k -> m -> IO ())       -- delete function
+      -> m -> [(k,v)]            -- the map & the elements from which to draw
+      -> Int                     -- the number of threads
+      -> Int                     -- the number of operations per thread
+      -> (Int, Int, Int)         -- ratio of lookups : insertions : deletions
+      -> [[IO ()]]
+mkOps lookup insert delete m elems nThreads nOps (rl,ri,rd) =
+    let tot = fromIntegral $ rl + ri + rd
+        numLookups = ceiling $ fromIntegral nOps * (fromIntegral rl / tot)
+        numInserts = ceiling $ fromIntegral nOps * (fromIntegral ri / tot)
+        numDeletes = ceiling $ fromIntegral nOps * (fromIntegral rd / tot)
+
+        lookupElems = shuffle' (take nOps $ cycle elems) nOps (mkStdGen 1234)
+        insertElems = shuffle' (take nOps $ cycle elems) nOps (mkStdGen 5678)
+        deleteElems = shuffle' (take nOps $ cycle elems) nOps (mkStdGen 9012)
+
+        ops0 = [lookup k   m | (k,_) <- take numLookups lookupElems]
+            ++ [insert k v m | (k,v) <- take numInserts insertElems]
+            ++ [delete k   m | (k,_) <- take numDeletes deleteElems]
+
+        ops = take nThreads
+            $ iterate (\ops -> shuffle' ops nOps (mkStdGen 1234))
+            $ take nOps ops0
+    in ops
+
+-----------------------------------------------------------------------
+-- Control.Concurrent.Map
+
+cmOps = mkOps cm_lookup CM.insert CM.delete
+
+cm_lookup :: (Eq k, Hashable k) => k -> CM.Map k v -> IO ()
+cm_lookup k m = do
+    let v = CM.lookup k m
+    v `seq` return ()
+{-# SPECIALIZE cm_lookup :: String -> CM.Map String Int -> IO () #-}
+{-# SPECIALIZE cm_lookup :: Int -> CM.Map Int Int -> IO () #-}
+
+
+-----------------------------------------------------------------------
+-- Data.HashMap
+
+hmOps = mkOps hm_lookup hm_insert hm_delete
+
+hm_lookup :: (Eq k, Hashable k) => k -> MVar (HM.HashMap k v) -> IO ()
+hm_lookup k mvar = do
+    --return undefined
+    m <- takeMVar mvar
+    putMVar mvar m
+    let v = HM.lookup k m
+    v `seq` return ()
+{-# SPECIALIZE hm_lookup :: String -> MVar (HM.HashMap String Int) -> IO () #-}
+{-# SPECIALIZE hm_lookup :: Int -> MVar (HM.HashMap Int Int) -> IO () #-}
+
+hm_insert :: (Eq k, Hashable k) => k -> v -> MVar (HM.HashMap k v) -> IO ()
+hm_insert k v mvar = do
+    --return ()
+    m <- takeMVar mvar
+    putMVar mvar $! HM.insert k v m
+{-# SPECIALIZE hm_insert :: String -> Int -> MVar (HM.HashMap String Int) -> IO () #-}
+{-# SPECIALIZE hm_insert :: Int -> Int -> MVar (HM.HashMap Int Int) -> IO () #-}
+
+hm_delete :: (Eq k, Hashable k) => k -> MVar (HM.HashMap k v) -> IO ()
+hm_delete k mvar = do
+    --return ()
+    m <- takeMVar mvar
+    putMVar mvar $! HM.delete k m
+{-# SPECIALIZE hm_delete :: String -> MVar (HM.HashMap String Int) -> IO () #-}
+{-# SPECIALIZE hm_delete :: Int -> MVar (HM.HashMap Int Int) -> IO () #-}
+
+
diff --git a/benchmarks/Sequential.hs b/benchmarks/Sequential.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Sequential.hs
@@ -0,0 +1,178 @@
+module Main where
+
+import Control.Applicative ((<$>))
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad.IO.Class (liftIO)
+import Criterion.Main
+import Criterion.Config
+import Data.Hashable
+import Data.List (foldl')
+import Data.Foldable (foldlM)
+import Data.Maybe
+import System.Random
+import System.IO.Unsafe
+
+import qualified Control.Concurrent.Map as CM
+import qualified Data.Map as M
+import qualified Data.IntMap as IM
+import qualified Data.HashMap.Strict as HM
+
+
+-- like with the tests, a lot of this is cribbed from unordered-containers
+
+main :: IO ()
+main = do
+    let mS = M.fromList elemsS :: M.Map String Int
+        mI = M.fromList elemsI :: M.Map Int Int
+        hmS = HM.fromList elemsS :: HM.HashMap String Int
+        hmI = HM.fromList elemsI :: HM.HashMap Int Int
+        imI = IM.fromList elemsI :: IM.IntMap Int
+    cmS <- CM.fromList elemsS :: IO (CM.Map String Int)
+    cmI <- CM.fromList elemsI :: IO (CM.Map Int Int)
+    defaultMainWith defaultConfig
+        (liftIO $ do
+            evaluate $ rnf mS
+            evaluate $ rnf mI
+            evaluate $ rnf hmS
+            evaluate $ rnf hmI
+            evaluate $ rnf imI
+            evaluate $ rnf $ unsafePerformIO $ CM.unsafeToList cmS
+            evaluate $ rnf $ unsafePerformIO $ CM.unsafeToList cmI
+        )
+        [
+            bgroup "Data.Map"
+            [ bgroup "lookup"
+                [ bench "String" $ whnf (lookupM keysS) mS
+                , bench "Int" $ whnf (lookupM keysI) mI
+                ]
+            , bgroup "insert"
+                [ bench "String" $ whnf (insertM elemsS) M.empty
+                , bench "Int" $ whnf (insertM elemsI) M.empty
+                ]
+            , bgroup "delete"
+                [ bench "String" $ whnf (deleteM keysS) mS
+                , bench "Int" $ whnf (deleteM keysI) mI
+                ]
+            ]
+
+            , bgroup "Data.HashMap"
+            [ bgroup "lookup"
+                [ bench "String" $ whnf (lookupHM keysS) hmS
+                , bench "Int" $ whnf (lookupHM keysI) hmI
+                ]
+            , bgroup "insert"
+                [ bench "String" $ whnf (insertHM elemsS) HM.empty
+                , bench "Int" $ whnf (insertHM elemsI) HM.empty
+                ]
+            , bgroup "delete"
+                [ bench "String" $ whnf (deleteHM keysS) hmS
+                , bench "Int" $ whnf (deleteHM keysI) hmI
+                ]
+            ]
+
+            , bgroup "Data.IntMap"
+            [ bgroup "lookup"
+                [ bench "Int" $ whnf (lookupIM keysI) imI ]
+            , bgroup "insert"
+                [ bench "Int" $ whnf (insertIM elemsI) IM.empty ]
+            , bgroup "delete"
+                [ bench "Int" $ whnf (deleteIM keysI) imI ]
+            ]
+
+            , bgroup "Control.Concurrent.Map"
+            [ bgroup "lookup"
+                [ bench "String" $ lookupCM keysS cmS
+                , bench "Int" $ lookupCM keysI cmI
+                ]
+            , bgroup "insert"
+                [ bench "String" $ insertCM elemsS =<< CM.empty
+                , bench "Int" $ insertCM elemsI =<< CM.empty
+                ]
+            , bgroup "delete"
+                [ bench "String" $ deleteCM keysS cmS
+                , bench "Int" $ deleteCM keysI cmI
+                ]
+            ]
+        ]
+    where
+        n = 2^12
+        elemsS = zip keysS [1..n]
+        elemsI = zip keysI [1..n]
+        keysS = rndS 8 n
+        keysI = rndI (n+n) n
+
+rndS :: Int -> Int -> [String]
+rndS strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 1234
+    where
+        split cs = case splitAt strlen cs of (str, cs') -> str : split cs'
+
+rndI :: Int -> Int -> [Int]
+rndI upper num = take num $ randomRs (0, upper) $ mkStdGen 1234
+
+-----------------------------------------------------------------------
+-- Control.Concurrent.Map
+
+lookupCM :: (Eq k, Hashable k) => [k] -> CM.Map k Int -> IO Int
+lookupCM xs m = foldlM (\z k -> fromMaybe z <$> (CM.lookup k m)) 0 xs
+{-# SPECIALIZE lookupCM :: [String] -> CM.Map String Int -> IO Int #-}
+{-# SPECIALIZE lookupCM :: [Int] -> CM.Map Int Int -> IO Int #-}
+
+insertCM :: (Eq k, Hashable k) => [(k, Int)] -> CM.Map k Int -> IO ()
+insertCM xs m = mapM_ (\(k,v) -> CM.insert k v m) xs
+{-# SPECIALIZE insertCM :: [(Int, Int)] -> CM.Map Int Int -> IO () #-}
+{-# SPECIALIZE insertCM :: [(String, Int)] -> CM.Map String Int -> IO () #-}
+
+deleteCM :: (Eq k, Hashable k) => [k] -> CM.Map k Int -> IO ()
+deleteCM xs m = mapM_ (\k -> CM.delete k m) xs
+{-# SPECIALIZE deleteCM :: [Int] -> CM.Map Int Int -> IO () #-}
+{-# SPECIALIZE deleteCM :: [String] -> CM.Map String Int -> IO () #-}
+
+-----------------------------------------------------------------------
+-- Data.Map
+
+lookupM :: Ord k => [k] -> M.Map k Int -> Int
+lookupM xs m = foldl' (\z k -> fromMaybe z (M.lookup k m)) 0 xs
+{-# SPECIALIZE lookupM :: [String] -> M.Map String Int -> Int #-}
+{-# SPECIALIZE lookupM :: [Int] -> M.Map Int Int -> Int #-}
+
+insertM :: Ord k => [(k, Int)] -> M.Map k Int -> M.Map k Int
+insertM xs m0 = foldl' (\m (k, v) -> M.insert k v m) m0 xs
+{-# SPECIALIZE insertM :: [(String, Int)] -> M.Map String Int -> M.Map String Int #-}
+{-# SPECIALIZE insertM :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int #-}
+
+deleteM :: Ord k => [k] -> M.Map k Int -> M.Map k Int
+deleteM xs m0 = foldl' (\m k -> M.delete k m) m0 xs
+{-# SPECIALIZE deleteM :: [String] -> M.Map String Int -> M.Map String Int #-}
+{-# SPECIALIZE deleteM :: [Int] -> M.Map Int Int -> M.Map Int Int #-}
+
+-----------------------------------------------------------------------
+-- Data.HashMap
+
+lookupHM :: (Eq k, Hashable k) => [k] -> HM.HashMap k Int -> Int
+lookupHM xs m = foldl' (\z k -> fromMaybe z (HM.lookup k m)) 0 xs
+{-# SPECIALIZE lookupHM :: [String] -> HM.HashMap String Int -> Int #-}
+{-# SPECIALIZE lookupHM :: [Int] -> HM.HashMap Int Int -> Int #-}
+
+insertHM :: (Eq k, Hashable k) => [(k, Int)] -> HM.HashMap k Int -> HM.HashMap k Int
+insertHM xs m0 = foldl' (\m (k, v) -> HM.insert k v m) m0 xs
+{-# SPECIALIZE insertHM :: [(Int, Int)] -> HM.HashMap Int Int -> HM.HashMap Int Int #-}
+{-# SPECIALIZE insertHM :: [(String, Int)] -> HM.HashMap String Int -> HM.HashMap String Int #-}
+
+deleteHM :: (Eq k, Hashable k) => [k] -> HM.HashMap k Int -> HM.HashMap k Int
+deleteHM xs m0 = foldl' (\m k -> HM.delete k m) m0 xs
+{-# SPECIALIZE deleteHM :: [Int] -> HM.HashMap Int Int -> HM.HashMap Int Int #-}
+{-# SPECIALIZE deleteHM :: [String] -> HM.HashMap String Int -> HM.HashMap String Int #-}
+
+
+-----------------------------------------------------------------------
+-- Data.IntMap
+
+lookupIM :: [Int] -> IM.IntMap Int -> Int
+lookupIM xs m = foldl' (\z k -> fromMaybe z (IM.lookup k m)) 0 xs
+
+insertIM :: [(Int, Int)] -> IM.IntMap Int -> IM.IntMap Int
+insertIM xs m0 = foldl' (\m (k, v) -> IM.insert k v m) m0 xs
+
+deleteIM :: [Int] -> IM.IntMap Int -> IM.IntMap Int
+deleteIM xs m0 = foldl' (\m k -> IM.delete k m) m0 xs
diff --git a/ctrie.cabal b/ctrie.cabal
new file mode 100644
--- /dev/null
+++ b/ctrie.cabal
@@ -0,0 +1,81 @@
+name:                ctrie
+version:             0.1.0.0
+synopsis:            Non-blocking concurrent map
+description:
+  A non-blocking concurrent map implementation based on 
+  /lock-free concurrent hash tries/ (aka /Ctries/).
+license:             MIT
+license-file:        LICENSE
+author:              Michael Schröder
+maintainer:          mcschroeder@gmail.com
+bug-reports:         https://github.com/mcschroeder/ctrie/issues
+copyright:           (c) 2013 Michael Schröder
+category:            Concurrency, Data Structures
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:   Control.Concurrent.Map
+  other-modules:     Control.Concurrent.Map.Array
+  build-depends:
+      base ==4.6.*
+    , hashable ==1.2.*
+    , primitive ==0.5.*
+
+  ghc-options: -Wall
+
+test-suite map-properties
+  hs-source-dirs:    tests
+  main-is:           MapProperties.hs
+  type:              exitcode-stdio-1.0
+
+  build-depends:
+      base
+    , QuickCheck ==2.5.*
+    , test-framework ==0.8.*
+    , test-framework-quickcheck2 ==0.3.*
+    , containers ==0.5.*
+    , hashable ==1.2.*
+    , ctrie
+
+benchmark sequential
+  hs-source-dirs:    benchmarks
+  main-is:           Sequential.hs
+  type:              exitcode-stdio-1.0
+
+  build-depends:
+      base
+    , hashable
+    , random
+    , transformers
+    , deepseq
+    , criterion
+    , containers
+    , unordered-containers
+    , ctrie
+
+  ghc-options: -O2 -rtsopts
+
+benchmark concurrent
+  hs-source-dirs:    benchmarks
+  main-is:           Concurrent.hs
+  type:              exitcode-stdio-1.0  
+
+  build-depends:
+      base
+    , async
+    , hashable
+    , random
+    , random-shuffle
+    , transformers
+    , deepseq
+    , criterion
+    , containers
+    , unordered-containers
+    , ctrie
+
+  ghc-options: -O2 -rtsopts -threaded
+
+source-repository head
+  type:     git
+  location: https://github.com/mcschroeder/ctrie.git
diff --git a/tests/MapProperties.hs b/tests/MapProperties.hs
new file mode 100644
--- /dev/null
+++ b/tests/MapProperties.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Main where
+
+import Control.Applicative
+import Control.Monad
+import Data.Hashable
+import Data.Function (on)
+import qualified Data.Map as M
+import qualified Data.List as L
+import qualified Control.Concurrent.Map as CM
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+import Test.Framework (defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+-- most of this based on the unordered-containers tests
+
+-----------------------------------------------------------------------
+
+main = defaultMain [ testGroup "basic interface"
+                        [ testProperty "lookup" pLookup
+                        , testProperty "insert" pInsert
+                        , testProperty "delete" pDelete
+                        ]
+                     , testGroup "conversions"
+                        [ testProperty "fromList" pFromList
+                        , testProperty "unsafeToList" pUnsafeToList
+                        ]
+                   ]
+
+-----------------------------------------------------------------------
+
+type Model k v = M.Map k v
+
+eq :: (Eq a, Eq k, Hashable k, Ord k)
+   => (Model k v -> a) -> (CM.Map k v -> IO a) -> [(k, v)] -> Property
+eq f g xs = monadicIO $ do
+    let a = f (M.fromList xs)
+    b <- run $ g =<< CM.fromList xs
+    assert $ a == b
+
+eq_ :: (Eq k, Eq v, Hashable k, Ord k)
+    => (Model k v -> Model k v) -> (CM.Map k v -> IO ()) -> [(k, v)] -> Property
+eq_ f g xs = monadicIO $ do
+    let a = M.toAscList $ f $ M.fromList xs
+    m <- run $ CM.fromList xs
+    run $ g m
+    b <- run $ unsafeToAscList m
+    assert $ a == b
+
+unsafeToAscList :: Ord k => CM.Map k v -> IO [(k, v)]
+unsafeToAscList m = do
+    xs <- CM.unsafeToList m
+    return $ L.sortBy (compare `on` fst) xs
+
+-----------------------------------------------------------------------
+
+-- key type that generates more hash collisions
+
+newtype Key = K { unK :: Int }
+    deriving (Arbitrary, Eq, Ord)
+
+instance Show Key where
+    show = show . unK
+
+instance Hashable Key where
+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
+
+-----------------------------------------------------------------------
+
+pLookup :: Key -> [(Key,Int)] -> Property
+pLookup k = M.lookup k `eq` CM.lookup k
+
+pInsert :: Key -> Int -> [(Key,Int)] -> Property
+pInsert k v = M.insert k v `eq_` CM.insert k v
+
+pDelete :: Key -> [(Key,Int)] -> Property
+pDelete k = M.delete k `eq_` CM.delete k
+
+pFromList :: [(Key,Int)] -> Property
+pFromList = id `eq_` (\_ -> return ())
+
+pUnsafeToList :: [(Key,Int)] -> Property
+pUnsafeToList = M.toAscList `eq` unsafeToAscList