diff --git a/Data/FullList/Lazy.hs b/Data/FullList/Lazy.hs
deleted file mode 100644
--- a/Data/FullList/Lazy.hs
+++ /dev/null
@@ -1,353 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP #-}
-
-------------------------------------------------------------------------
--- |
--- Module      :  Data.FullList.Lazy
--- Copyright   :  2010-2011 Johan Tibell
--- License     :  BSD-style
--- Maintainer  :  johan.tibell@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- Non-empty lists of key/value pairs.  The lists are strict in the
--- keys and lazy in the values.
-
-module Data.FullList.Lazy
-    ( FullList(..)
-    , List(..)
-
-      -- * Basic interface
-    , size
-    , singleton
-    , lookup
-    , insert
-    , delete
-    , insertWith
-    , adjust
-
-      -- * Combine
-      -- * Union
-    , union
-    , unionWith
-
-      -- * Transformations
-    , map
-    , traverseWithKey
-
-      -- * Folds
-    , foldlWithKey'
-    , foldrWithKey
-
-      -- * Filter
-    , filterWithKey
-      -- * For use by FL.Strict
-    , lookupL
-    , deleteL
-    ) where
-
-import Control.Applicative
-import Control.DeepSeq (NFData(rnf))
-import Prelude hiding (lookup, map)
-
-------------------------------------------------------------------------
--- * The 'FullList' type
-
--- The 'FullList' type has two benefits:
---
---  * it is guaranteed to be non-empty, and
---
---  * it can be unpacked into a data constructor.
-
--- Invariant: the same key only appears once in a 'FullList'.
-
--- | A non-empty list of key/value pairs.
-data FullList k v = FL !k v !(List k v)
-                  deriving Show
-
-instance (Eq k, Eq v) => Eq (FullList k v) where
-    (FL k1 v1 xs) == (FL k2 v2 ys) = k1 == k2 && v1 == v2 && xs == ys
-    (FL k1 v1 xs) /= (FL k2 v2 ys) = k1 /= k2 || v1 /= v2 || xs /= ys
-
-instance (NFData k, NFData v) => NFData (FullList k v)
-
-data List k v = Nil | Cons !k v !(List k v)
-              deriving Show
-
-instance (Eq k, Eq v) => Eq (List k v) where
-    (Cons k1 v1 xs) == (Cons k2 v2 ys) = k1 == k2 && v1 == v2 && xs == ys
-    Nil == Nil = True
-    _   == _   = False
-
-    (Cons k1 v1 xs) /= (Cons k2 v2 ys) = k1 /= k2 || v1 /= v2 || xs /= ys
-    Nil /= Nil = False
-    _   /= _   = True
-
-instance (NFData k, NFData v) => NFData (List k v) where
-    rnf Nil           = ()
-    rnf (Cons k v xs) = rnf k `seq` rnf v `seq` rnf xs
-
--- TODO: Check if evaluation is forced.
-
-------------------------------------------------------------------------
--- * FullList
-
--- The 'List' functions are not inlined as they should be seldomly
--- called in practice (i.e. we expect few collisions.)
-
-size :: FullList k v -> Int
-size (FL _ _ xs) = 1 + sizeL xs
-
-sizeL :: List k v -> Int
-sizeL Nil = 0
-sizeL (Cons _ _ xs) = 1 + sizeL xs
-
-singleton :: k -> v -> FullList k v
-singleton k v = FL k v Nil
-
-lookup :: Eq k => k -> FullList k v -> Maybe v
-lookup !k (FL k' v xs)
-    | k == k'   = Just v
-    | otherwise = lookupL k xs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE lookup #-}
-#endif
-
-lookupL :: Eq k => k -> List k v -> Maybe v
-lookupL = go
-  where
-    go !_ Nil = Nothing
-    go k (Cons k' v xs)
-        | k == k'   = Just v
-        | otherwise = go k xs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE lookupL #-}
-#endif
-
-member :: Eq k => k -> FullList k v -> Bool
-member !k (FL k' _ xs)
-    | k == k'   = True
-    | otherwise = memberL k xs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE member #-}
-#endif
-
-memberL :: Eq k => k -> List k v -> Bool
-memberL = go
-  where
-    go !_ Nil = False
-    go k (Cons k' _ xs)
-        | k == k'   = True
-        | otherwise = go k xs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE memberL #-}
-#endif
-
-insert :: Eq k => k -> v -> FullList k v -> FullList k v
-insert !k v (FL k' v' xs)
-    | k == k'   = FL k v xs
-    | otherwise = FL k' v' (insertL k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insert #-}
-#endif
-
--- | /O(n)/ Insert at the head of the list to avoid copying the whole
--- list.
-insertL :: Eq k => k -> v -> List k v -> List k v
-insertL = go
-  where
-    go !k v Nil = Cons k v Nil
-    go k v (Cons k' v' xs)
-        | k == k'   = Cons k v xs
-        | otherwise = Cons k' v' (go k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertL #-}
-#endif
-
-delete :: Eq k => k -> FullList k v -> Maybe (FullList k v)
-delete !k (FL k' v xs)
-    | k == k'   = case xs of
-        Nil             -> Nothing
-        Cons k'' v' xs' -> Just $ FL k'' v' xs'
-    | otherwise = let ys = deleteL k xs
-                  in ys `seq` Just (FL k' v ys)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE delete #-}
-#endif
-
-deleteL :: Eq k => k -> List k v -> List k v
-deleteL = go
-  where
-    go !_ Nil = Nil
-    go k (Cons k' v xs)
-        | k == k'   = xs
-        | otherwise = Cons k' v (go k xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE deleteL #-}
-#endif
-
-insertWith :: Eq k => (v -> v -> v) -> k -> v -> FullList k v -> FullList k v
-insertWith f !k v (FL k' v' xs)
-    | k == k'   = FL k (f v v') xs
-    | otherwise = FL k' v' (insertWithL f k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertWith #-}
-#endif
-
-insertWithL :: Eq k => (v -> v -> v) -> k -> v -> List k v -> List k v
-insertWithL = go
-  where
-    go _ !k v Nil = Cons k v Nil
-    go f k v (Cons k' v' xs)
-        | k == k'   = Cons k (f v v') xs
-        | otherwise = Cons k' v' (go f k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertWithL #-}
-#endif
-
-adjust :: Eq k => (v -> v) -> k -> FullList k v -> FullList k v
-adjust f !k (FL k' v xs)
-  | k == k' = FL k' (f v) xs
-  | otherwise = FL k' v (adjustL f k xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE adjust #-}
-#endif
-
-adjustL :: Eq k => (v -> v) -> k -> List k v -> List k v
-adjustL f = go
-  where
-    go !_ Nil = Nil
-    go k (Cons k' v xs)
-      | k == k' = Cons k' (f v) xs
-      | otherwise = Cons k' v (go k xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE adjustL #-}
-#endif
-
-------------------------------------------------------------------------
--- * Combine
-
--- | /O(n^2)/ Left biased union.
-union :: Eq k => FullList k v -> FullList k v -> FullList k v
-union xs (FL k v ys)
-    | k `member` xs = unionL xs ys
-    | otherwise     = case unionL xs ys of
-        FL k' v' zs -> FL k v $ Cons k' v' zs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE union #-}
-#endif
-
-unionL :: Eq k => FullList k v -> List k v -> FullList k v
-unionL xs@(FL k v zs) = FL k v . go
-  where
-    go Nil = zs
-    go (Cons k' v' ys)
-        | k' `member` xs = go ys
-        | otherwise      = Cons k' v' $ go ys
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionL #-}
-#endif
-
-unionWith :: Eq k => (v -> v -> v) -> FullList k v -> FullList k v -> FullList k v
-unionWith f xs (FL k vy ys) =
-    case lookup k xs of
-      Just vx ->
-        let flCon = FL k (f vx vy)
-        in case delete k xs of
-          Nothing  -> flCon ys
-          Just xs' ->
-            case unionWithL f xs' ys of
-              FL k' v' zs -> flCon $ Cons k' v' zs
-      Nothing ->
-        case unionWithL f xs ys of
-          FL k' v' zs -> FL k vy $ Cons k' v' zs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWith #-}
-#endif
-
-unionWithL :: Eq k => (v -> v -> v) -> FullList k v -> List k v -> FullList k v
-unionWithL f (FL k v zs) ys =
-  case lookupL k ys of 
-    Just vy -> FL k (f v vy) $ go zs (deleteL k ys)
-    Nothing -> FL k v (go zs ys)
-  where
-    go ws Nil = ws
-    go ws (Cons k' vy ys') =
-      case lookupL k' ws of
-        Just vx -> Cons k' (f vx vy) $ go (deleteL k' ws) ys'
-        Nothing -> Cons k' vy $ go ws ys'
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWithL #-}
-#endif
-
-------------------------------------------------------------------------
--- * Transformations
-
-map :: (k1 -> v1 -> (k2, v2)) -> FullList k1 v1 -> FullList k2 v2
-map f (FL k v xs) = let (k', v') = f k v
-                    in FL k' v' (mapL f xs)
-{-# INLINE map #-}
-
-mapL :: (k1 -> v1 -> (k2, v2)) -> List k1 v1 -> List k2 v2
-mapL f = go
-  where
-    go Nil = Nil
-    go (Cons k v xs) = let (k', v') = f k v
-                       in Cons k' v' (go xs)
-{-# INLINE mapL #-}
-
-traverseWithKey :: Applicative m => (k -> v1 -> m v2) -> FullList k v1 -> m (FullList k v2)
-traverseWithKey f (FL k v xs) = FL k <$> f k v <*> traverseWithKeyL f xs
-{-# INLINE traverseWithKey #-}
-
-traverseWithKeyL :: Applicative m => (k -> v1 -> m v2) -> List k v1 -> m (List k v2)
-traverseWithKeyL f = go
-  where
-    go Nil = pure Nil
-    go (Cons k v xs) = Cons k <$> f k v <*> go xs
-{-# INLINE traverseWithKeyL #-}
-
-------------------------------------------------------------------------
--- * Folds
-
-foldlWithKey' :: (a -> k -> v -> a) -> a -> FullList k v -> a
-foldlWithKey' f !z (FL k v xs) = foldlWithKey'L f (f z k v) xs
-{-# INLINE foldlWithKey' #-}
-
-foldlWithKey'L :: (a -> k -> v -> a) -> a -> List k v -> a
-foldlWithKey'L f = go
-  where
-    go !z Nil          = z
-    go z (Cons k v xs) = go (f z k v) xs
-{-# INLINE foldlWithKey'L #-}
-
-foldrWithKey :: (k -> v -> a -> a) -> a -> FullList k v -> a
-foldrWithKey f z (FL k v xs) = f k v (foldrWithKeyL f z xs)
-{-# INLINE foldrWithKey #-}
-
-foldrWithKeyL :: (k -> v -> a -> a) -> a -> List k v -> a
-foldrWithKeyL f = go
-  where
-    go z Nil = z
-    go z (Cons k v xs) = f k v (go z xs)
-{-# INLINE foldrWithKeyL #-}
-
-------------------------------------------------------------------------
--- * Filter
-
-filterWithKey :: (k -> v -> Bool) -> FullList k v -> Maybe (FullList k v)
-filterWithKey p (FL k v xs)
-    | p k v     = Just (FL k v ys)
-    | otherwise = case ys of
-        Nil           -> Nothing
-        Cons k' v' zs -> Just $ FL k' v' zs
-  where !ys = filterWithKeyL p xs
-{-# INLINE filterWithKey #-}
-
-filterWithKeyL :: (k -> v -> Bool) -> List k v -> List k v
-filterWithKeyL p = go
-  where
-    go Nil = Nil
-    go (Cons k v xs)
-        | p k v     = Cons k v (go xs)
-        | otherwise = go xs
-{-# INLINE filterWithKeyL #-}
diff --git a/Data/FullList/Strict.hs b/Data/FullList/Strict.hs
deleted file mode 100644
--- a/Data/FullList/Strict.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP #-}
-
-------------------------------------------------------------------------
--- |
--- Module      :  Data.FullList.Strict
--- Copyright   :  2010-2011 Johan Tibell
--- License     :  BSD-style
--- Maintainer  :  johan.tibell@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- Non-empty lists of key/value pairs.  The lists are strict in the
--- keys and the values.
-
-module Data.FullList.Strict
-    ( FullList
-
-      -- * Basic interface
-    , size
-    , singleton
-    , lookup
-    , insert
-    , delete
-    , insertWith
-    , adjust
-
-      -- * Combine
-      -- ** Union
-    , unionWith
-
-      -- * Transformations
-    , map
-    , traverseWithKey
-
-      -- * Folds
-    , foldlWithKey'
-    , foldrWithKey
-
-      -- * Filter
-    , filterWithKey
-    ) where
-
-import Prelude hiding (lookup, map)
-
-import Data.FullList.Lazy hiding (insertWith, map, adjust, unionWith)
-
-insertWith :: Eq k => (v -> v -> v) -> k -> v -> FullList k v -> FullList k v
-insertWith f !k v (FL k' v' xs)
-    | k == k'   = let v'' = f v v' in v'' `seq` FL k v'' xs
-    | otherwise = FL k' v' (insertWithL f k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertWith #-}
-#endif
-
-insertWithL :: Eq k => (v -> v -> v) -> k -> v -> List k v -> List k v
-insertWithL = go
-  where
-    go _ !k v Nil = Cons k v Nil
-    go f k v (Cons k' v' xs)
-        | k == k'   = let v'' = f v v' in v'' `seq` Cons k v'' xs
-        | otherwise = Cons k' v' (go f k v xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertWithL #-}
-#endif
-
-adjust :: Eq k => (v -> v) -> k -> FullList k v -> FullList k v
-adjust f !k (FL k' v xs)
-  | k == k' = let v' = f v in v' `seq` FL k' v' xs
-  | otherwise = FL k' v (adjustL f k xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE adjust #-}
-#endif
-
-adjustL :: Eq k => (v -> v) -> k -> List k v -> List k v
-adjustL f = go
-  where
-    go !_ Nil = Nil
-    go k (Cons k' v xs)
-      | k == k' = let v' = f v in v' `seq` Cons k' v' xs
-      | otherwise = Cons k' v (go k xs)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE adjustL #-}
-#endif
-
-------------------------------------------------------------------------
--- * Transformations
-
-map :: (k1 -> v1 -> (k2, v2)) -> FullList k1 v1 -> FullList k2 v2
-map f (FL k v xs) = let !(k', !v') = f k v
-                    in FL k' v' (mapL f xs)
-{-# INLINE map #-}
-
-mapL :: (k1 -> v1 -> (k2, v2)) -> List k1 v1 -> List k2 v2
-mapL f = go
-  where
-    go Nil = Nil
-    go (Cons k v xs) = let !(k', !v') = f k v
-                       in Cons k' v' (go xs)
-{-# INLINE mapL #-}
-
-unionWith :: Eq k => (v -> v -> v) -> FullList k v -> FullList k v -> FullList k v
-unionWith f xs (FL k vy ys) =
-    case lookup k xs of
-      Just vx ->
-        let !vFinal = f vx vy
-            flCon = FL k vFinal
-        in case delete k xs of
-          Nothing -> flCon ys
-          Just xs' ->
-            case unionWithL f xs' ys of
-              FL k' v' zs -> flCon $ Cons k' v' zs
-      Nothing ->
-        case unionWithL f xs ys of
-          FL k' v' zs -> FL k vy $ Cons k' v' zs
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWith #-}
-#endif
-
-unionWithL :: Eq k => (v -> v -> v) -> FullList k v -> List k v -> FullList k v
-unionWithL f (FL k v zs) ys =
-  case lookupL k ys of
-    Just vy -> let !vFinal = f v vy in FL k vFinal $ go zs (deleteL k ys)
-    Nothing -> FL k v (go zs ys)
-  where
-    go ws Nil = ws
-    go ws (Cons k' vy ys') =
-      case lookupL k' ws of
-        Just vx -> let !vFinal = f vx vy in Cons k' vFinal $ go (deleteL k' ws) ys'
-        Nothing -> Cons k' vy $ go ws ys'
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWithL #-}
-#endif
diff --git a/Data/HashMap/Array.hs b/Data/HashMap/Array.hs
new file mode 100644
--- /dev/null
+++ b/Data/HashMap/Array.hs
@@ -0,0 +1,413 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-- | Zero based arrays.
+--
+-- Note that no bounds checking are performed.
+module Data.HashMap.Array
+    ( Array
+    , MArray
+
+      -- * Creation
+    , new
+    , new_
+    , singleton
+    , singleton'
+    , pair
+
+      -- * Basic interface
+    , length
+    , lengthM
+    , read
+    , write
+    , index
+    , index_
+    , indexM_
+    , update
+    , update'
+    , updateWith
+    , insert
+    , insert'
+    , delete
+    , delete'
+
+    , unsafeFreeze
+    , run
+    , run2
+    , copy
+    , copyM
+
+      -- * Folds
+    , foldl'
+    , foldr
+
+    , thaw
+    , map
+    , map'
+    , traverse
+    , filter
+    ) where
+
+import qualified Data.Traversable as Traversable
+import Control.Applicative (Applicative)
+import Control.DeepSeq
+import Control.Monad.ST
+import GHC.Exts
+import GHC.ST (ST(..))
+import Prelude hiding (filter, foldr, length, map, read)
+
+------------------------------------------------------------------------
+
+#if defined(ASSERTS)
+-- This fugly hack is brought by GHC's apparent reluctance to deal
+-- with MagicHash and UnboxedTuples when inferring types. Eek!
+# define CHECK_BOUNDS(_func_,_len_,_k_) \
+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.HashMap.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
+# define CHECK_OP(_func_,_op_,_lhs_,_rhs_) \
+if not ((_lhs_) _op_ (_rhs_)) then error ("Data.HashMap.Array." ++ (_func_) ++ ": Check failed: _lhs_ _op_ _rhs_ (" ++ show (_lhs_) ++ " vs. " ++ show (_rhs_) ++ ")") else
+# define CHECK_GT(_func_,_lhs_,_rhs_) CHECK_OP(_func_,>,_lhs_,_rhs_)
+# define CHECK_LE(_func_,_lhs_,_rhs_) CHECK_OP(_func_,<=,_lhs_,_rhs_)
+#else
+# define CHECK_BOUNDS(_func_,_len_,_k_)
+# define CHECK_OP(_func_,_op_,_lhs_,_rhs_)
+# define CHECK_GT(_func_,_lhs_,_rhs_)
+# define CHECK_LE(_func_,_lhs_,_rhs_)
+#endif
+
+data Array a = Array {
+      unArray :: !(Array# a)
+#if __GLASGOW_HASKELL__ < 702
+    , length :: !Int
+#endif
+    }
+
+instance Show a => Show (Array a) where
+    show = show . toList
+
+#if __GLASGOW_HASKELL__ >= 702
+length :: Array a -> Int
+length ary = I# (sizeofArray# (unArray ary))
+{-# INLINE length #-}
+#endif
+
+-- | Smart constructor
+array :: Array# a -> Int -> Array a
+#if __GLASGOW_HASKELL__ >= 702
+array ary _n = Array ary
+#else
+array = Array
+#endif
+{-# INLINE array #-}
+
+data MArray s a = MArray {
+      unMArray :: !(MutableArray# s a)
+#if __GLASGOW_HASKELL__ < 702
+    , lengthM :: !Int
+#endif
+    }
+
+#if __GLASGOW_HASKELL__ >= 702
+lengthM :: MArray s a -> Int
+lengthM mary = I# (sizeofMutableArray# (unMArray mary))
+{-# INLINE lengthM #-}
+#endif
+
+-- | Smart constructor
+marray :: MutableArray# s a -> Int -> MArray s a
+#if __GLASGOW_HASKELL__ >= 702
+marray mary _n = MArray mary
+#else
+marray = MArray
+#endif
+{-# INLINE marray #-}
+
+------------------------------------------------------------------------
+
+instance NFData a => NFData (Array a) where
+    rnf = rnfArray
+
+rnfArray :: NFData a => Array a -> ()
+rnfArray ary0 = go ary0 n0 0
+  where
+    n0 = length ary0
+    go !ary !n !i
+        | i >= n = ()
+        | otherwise = rnf (index ary i) `seq` go ary n (i+1)
+{-# INLINE rnfArray #-}
+
+-- | Create a new mutable array of specified size, in the specified
+-- state thread, with each element containing the specified initial
+-- value.
+new :: Int -> a -> ST s (MArray s a)
+new n@(I# n#) b =
+    CHECK_GT("new",n,(0 :: Int))
+    ST $ \s ->
+        case newArray# n# b s of
+            (# s', ary #) -> (# s', marray ary n #)
+{-# INLINE new #-}
+
+new_ :: Int -> ST s (MArray s a)
+new_ n = new n undefinedElem
+
+singleton :: a -> Array a
+singleton x = runST (singleton' x)
+{-# INLINE singleton #-}
+
+singleton' :: a -> ST s (Array a)
+singleton' x = new 1 x >>= unsafeFreeze
+{-# INLINE singleton' #-}
+
+pair :: a -> a -> Array a
+pair x y = run $ do
+    ary <- new 2 x
+    write ary 1 y
+    return ary
+{-# INLINE pair #-}
+
+read :: MArray s a -> Int -> ST s a
+read ary _i@(I# i#) = ST $ \ s ->
+    CHECK_BOUNDS("read", lengthM ary, _i)
+        readArray# (unMArray ary) i# s
+{-# INLINE read #-}
+
+write :: MArray s a -> Int -> a -> ST s ()
+write ary _i@(I# i#) b = ST $ \ s ->
+    CHECK_BOUNDS("write", lengthM ary, _i)
+        case writeArray# (unMArray ary) i# b s of
+            s' -> (# s' , () #)
+{-# INLINE write #-}
+
+index :: Array a -> Int -> a
+index ary _i@(I# i#) =
+    CHECK_BOUNDS("index", length ary, _i)
+        case indexArray# (unArray ary) i# of (# b #) -> b
+{-# INLINE index #-}
+
+index_ :: Array a -> Int -> ST s a
+index_ ary _i@(I# i#) =
+    CHECK_BOUNDS("index_", length ary, _i)
+        case indexArray# (unArray ary) i# of (# b #) -> return b
+{-# INLINE index_ #-}
+
+indexM_ :: MArray s a -> Int -> ST s a
+indexM_ ary _i@(I# i#) =
+    CHECK_BOUNDS("index_", lengthM ary, _i)
+        ST $ \ s# -> readArray# (unMArray ary) i# s#
+{-# INLINE indexM_ #-}
+
+unsafeFreeze :: MArray s a -> ST s (Array a)
+unsafeFreeze mary
+    = ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of
+                   (# s', ary #) -> (# s', array ary (lengthM mary) #)
+{-# INLINE unsafeFreeze #-}
+
+run :: (forall s . ST s (MArray s e)) -> Array e
+run act = runST $ act >>= unsafeFreeze
+{-# INLINE run #-}
+
+run2 :: (forall s. ST s (MArray s e, a)) -> (Array e, a)
+run2 k = runST (do
+                 (marr,b) <- k
+                 arr <- unsafeFreeze marr
+                 return (arr,b))
+
+-- | Unsafely copy the elements of an array. Array bounds are not checked.
+copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
+#if __GLASGOW_HASKELL__ >= 702
+copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
+    CHECK_LE("copy", _sidx + _n, length src)
+    CHECK_LE("copy", _didx + _n, lengthM dst)
+        ST $ \ s# ->
+        case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of
+            s2 -> (# s2, () #)
+#else
+copy !src !sidx !dst !didx n =
+    CHECK_LE("copy", sidx + n, length src)
+    CHECK_LE("copy", didx + n, lengthM dst)
+        copy_loop sidx didx 0
+  where
+    copy_loop !i !j !c
+        | c >= n = return ()
+        | otherwise = do b <- index_ src i
+                         write dst j b
+                         copy_loop (i+1) (j+1) (c+1)
+#endif
+
+-- | Unsafely copy the elements of an array. Array bounds are not checked.
+copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
+#if __GLASGOW_HASKELL__ >= 702
+copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
+    CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
+    CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
+    ST $ \ s# ->
+    case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of
+        s2 -> (# s2, () #)
+#else
+copyM !src !sidx !dst !didx n =
+    CHECK_BOUNDS("copyM: src", lengthM src, sidx + n - 1)
+    CHECK_BOUNDS("copyM: dst", lengthM dst, didx + n - 1)
+    copy_loop sidx didx 0
+  where
+    copy_loop !i !j !c
+        | c >= n = return ()
+        | otherwise = do b <- indexM_ src i
+                         write dst j b
+                         copy_loop (i+1) (j+1) (c+1)
+#endif
+
+-- | /O(n)/ Insert an element at the given position in this array,
+-- increasing its size by one.
+insert :: Array e -> Int -> e -> Array e
+insert ary idx b = runST (insert' ary idx b)
+{-# INLINE insert #-}
+
+-- | /O(n)/ Insert an element at the given position in this array,
+-- increasing its size by one.
+insert' :: Array e -> Int -> e -> ST s (Array e)
+insert' ary idx b =
+    CHECK_BOUNDS("insert'", count + 1, idx)
+        do mary <- new_ (count+1)
+           copy ary 0 mary 0 idx
+           write mary idx b
+           copy ary idx mary (idx+1) (count-idx)
+           unsafeFreeze mary
+  where !count = length ary
+{-# INLINE insert' #-}
+
+-- | /O(n)/ Update the element at the given position in this array.
+update :: Array e -> Int -> e -> Array e
+update ary idx b = runST (update' ary idx b)
+{-# INLINE update #-}
+
+-- | /O(n)/ Update the element at the given position in this array.
+update' :: Array e -> Int -> e -> ST s (Array e)
+update' ary idx b =
+    CHECK_BOUNDS("update'", count, idx)
+        do mary <- thaw ary 0 count
+           write mary idx b
+           unsafeFreeze mary
+  where !count = length ary
+{-# INLINE update' #-}
+
+-- | /O(n)/ Update the element at the given positio in this array, by
+-- applying a function to it.  Evaluates the element to WHNF before
+-- inserting it into the array.
+updateWith :: Array e -> Int -> (e -> e) -> Array e
+updateWith ary idx f = update ary idx $! f (index ary idx)
+{-# INLINE updateWith #-}
+
+foldl' :: (b -> a -> b) -> b -> Array a -> b
+foldl' f = \ z0 ary0 -> go ary0 (length ary0) 0 z0
+  where
+    go ary n i !z
+        | i >= n    = z
+        | otherwise = go ary n (i+1) (f z (index ary i))
+{-# INLINE foldl' #-}
+
+foldr :: (a -> b -> b) -> b -> Array a -> b
+foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0
+  where
+    go ary n i z
+        | i >= n    = z
+        | otherwise = f (index ary i) (go ary n (i+1) z)
+{-# INLINE foldr #-}
+
+undefinedElem :: a
+undefinedElem = error "Data.HashMap.Array: Undefined element"
+{-# NOINLINE undefinedElem #-}
+
+thaw :: Array e -> Int -> Int -> ST s (MArray s e)
+#if __GLASGOW_HASKELL__ >= 702
+thaw !ary !_o@(I# o#) !n@(I# n#) =
+    CHECK_LE("thaw", _o + n, length ary)
+        ST $ \ s -> case thawArray# (unArray ary) o# n# s of
+            (# s2, mary# #) -> (# s2, marray mary# n #)
+#else
+thaw !ary !o !n =
+    CHECK_LE("thaw", o + n, length ary)
+        do mary <- new_ n
+           copy ary o mary 0 n
+           return mary
+#endif
+{-# INLINE thaw #-}
+
+-- | /O(n)/ Delete an element at the given position in this array,
+-- decreasing its size by one.
+delete :: Array e -> Int -> Array e
+delete ary idx = runST (delete' ary idx)
+{-# INLINE delete #-}
+
+-- | /O(n)/ Delete an element at the given position in this array,
+-- decreasing its size by one.
+delete' :: Array e -> Int -> ST s (Array e)
+delete' ary idx = do
+    mary <- new_ (count-1)
+    copy ary 0 mary 0 idx
+    copy ary (idx+1) mary idx (count-(idx+1))
+    unsafeFreeze mary
+  where !count = length ary
+{-# INLINE delete' #-}
+
+map :: (a -> b) -> Array a -> Array b
+map f = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 n
+  where
+    go ary mary i n
+        | i >= n    = return mary
+        | otherwise = do
+             write mary i $ f (index ary i)
+             go ary mary (i+1) n
+{-# INLINE map #-}
+
+-- | Strict version of 'map'.
+map' :: (a -> b) -> Array a -> Array b
+map' f = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 n
+  where
+    go ary mary i n
+        | i >= n    = return mary
+        | otherwise = do
+             write mary i $! f (index ary i)
+             go ary mary (i+1) n
+{-# INLINE map' #-}
+
+fromList :: Int -> [a] -> Array a
+fromList n xs0 = run $ do
+    mary <- new_ n
+    go xs0 mary 0
+  where
+    go [] !mary !_   = return mary
+    go (x:xs) mary i = do write mary i x
+                          go xs mary (i+1)
+
+toList :: Array a -> [a]
+toList = foldr (:) []
+
+traverse :: Applicative f => (a -> f b) -> Array a -> f (Array b)
+traverse f = \ ary -> fromList (length ary) `fmap`
+                      Traversable.traverse f (toList ary)
+{-# INLINE traverse #-}
+
+filter :: (a -> Bool) -> Array a -> Array a
+filter p = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 0 n
+  where
+    go ary mary i j n
+        | i >= n    = if i == j
+                      then return mary
+                      else do mary2 <- new_ j
+                              copyM mary 0 mary2 0 j
+                              return mary2
+        | p el      = write mary j el >> go ary mary (i+1) (j+1) n
+        | otherwise = go ary mary (i+1) j n
+      where el = index ary i
+{-# INLINE filter #-}
diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
new file mode 100644
--- /dev/null
+++ b/Data/HashMap/Base.hs
@@ -0,0 +1,947 @@
+{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+module Data.HashMap.Base
+    (
+      HashMap(..)
+    , Leaf(..)
+
+      -- * Construction
+    , empty
+    , singleton
+
+      -- * Basic interface
+    , null
+    , size
+    , lookup
+    , lookupDefault
+    , insert
+    , insertWith
+    , delete
+    , adjust
+
+      -- * Combine
+      -- ** Union
+    , union
+    , unionWith
+
+      -- * Transformations
+    , map
+    , traverseWithKey
+
+      -- * Difference and intersection
+    , difference
+    , intersection
+
+      -- * Folds
+    , foldl'
+    , foldlWithKey'
+    , foldr
+    , foldrWithKey
+
+      -- * Filter
+    , filter
+    , filterWithKey
+
+      -- * Conversions
+    , keys
+    , elems
+
+      -- ** Lists
+    , toList
+    , fromList
+    , fromListWith
+
+      -- Internals used by the strict version
+    , Bitmap
+    , bitmapIndexedOrFull
+    , collision
+    , hash
+    , mask
+    , index
+    , bitsPerSubkey
+    , fullNodeMask
+    , sparseIndex
+    , two
+    , unionArrayBy
+    , update16
+    , update16'
+    , update16With
+    , updateOrConcatWith
+    ) where
+
+import Control.Applicative ((<$>), Applicative(pure))
+import Control.DeepSeq (NFData(rnf))
+import Control.Monad.ST (ST, runST)
+import Data.Bits ((.&.), (.|.), complement)
+import qualified Data.Foldable as Foldable
+import qualified Data.List as L
+import Data.Monoid (Monoid(mempty, mappend))
+import Data.Traversable (Traversable(..))
+import Data.Word (Word)
+import Prelude hiding (filter, foldr, lookup, map, null, pred)
+
+import qualified Data.HashMap.Array as A
+import qualified Data.Hashable as H
+import Data.Hashable (Hashable)
+import Data.HashMap.PopCount (popCount)
+import Data.HashMap.UnsafeShift (unsafeShiftL, unsafeShiftR)
+import Data.Typeable (Typeable)
+
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
+#endif
+
+------------------------------------------------------------------------
+
+-- | Convenience function.  Compute a hash value for the given value.
+hash :: H.Hashable a => a -> Hash
+hash = fromIntegral . H.hash
+
+data Leaf k v = L !k v
+
+instance (NFData k, NFData v) => NFData (Leaf k v) where
+    rnf (L k v) = rnf k `seq` rnf v
+
+-- Invariant: The length of the 1st argument to 'Full' is
+-- 2^bitsPerSubkey
+
+-- | A map from keys to values.  A map cannot contain duplicate keys;
+-- each key can map to at most one value.
+data HashMap k v
+    = Empty
+    | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
+    | Leaf !Hash !(Leaf k v)
+    | Full !(A.Array (HashMap k v))
+    | Collision !Hash !(A.Array (Leaf k v))
+      deriving (Typeable)
+
+instance (NFData k, NFData v) => NFData (HashMap k v) where
+    rnf Empty                 = ()
+    rnf (BitmapIndexed _ ary) = rnf ary
+    rnf (Leaf _ l)            = rnf l
+    rnf (Full ary)            = rnf ary
+    rnf (Collision _ ary)     = rnf ary
+
+instance Functor (HashMap k) where
+    fmap = map
+
+instance Foldable.Foldable (HashMap k) where
+    foldr f = foldrWithKey (const f)
+
+instance (Eq k, Hashable k) => Monoid (HashMap k v) where
+  mempty = empty
+  {-# INLINE mempty #-}
+  mappend = union
+  {-# INLINE mappend #-}
+
+type Hash   = Word
+type Bitmap = Word
+type Shift  = Int
+
+instance (Show k, Show v) => Show (HashMap k v) where
+    show m = "fromList " ++ show (toList m)
+
+instance Traversable (HashMap k) where
+    traverse f = traverseWithKey (const f)
+
+-- NOTE: This is just a placeholder.
+instance (Eq k, Eq v) => Eq (HashMap k v) where
+    a == b = toList a == toList b
+
+------------------------------------------------------------------------
+-- * Construction
+
+-- | /O(1)/ Construct an empty map.
+empty :: HashMap k v
+empty = Empty
+
+-- | /O(1)/ Construct a map with a single element.
+singleton :: (Hashable k) => k -> v -> HashMap k v
+singleton k v = Leaf (hash k) (L k v)
+
+------------------------------------------------------------------------
+-- * Basic interface
+
+-- | /O(1)/ Return 'True' if this map is empty, 'False' otherwise.
+null :: HashMap k v -> Bool
+null Empty = True
+null _   = False
+
+-- | /O(n)/ Return the number of key-value mappings in this map.
+size :: HashMap k v -> Int
+size t = go t 0
+  where
+    go Empty                !n = n
+    go (Leaf _ _)            n = n + 1
+    go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
+    go (Full ary)            n = A.foldl' (flip go) n ary
+    go (Collision _ ary)     n = n + A.length ary
+
+-- | /O(log n)/ Return the value to which the specified key is mapped,
+-- or 'Nothing' if this map contains no mapping for the key.
+lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
+lookup k0 = go h0 k0 0
+  where
+    h0 = hash k0
+    go !_ !_ !_ Empty = Nothing
+    go h k _ (Leaf hx (L kx x))
+        | h == hx && k == kx = Just x
+        | otherwise          = Nothing
+    go h k s (BitmapIndexed b v)
+        | b .&. m == 0 = Nothing
+        | otherwise    = go h k (s+bitsPerSubkey) (A.index v (sparseIndex b m))
+      where m = mask h s
+    go h k s (Full v) = go h k (s+bitsPerSubkey) (A.index v (index h s))
+    go h k _ (Collision hx v)
+        | h == hx   = lookupInArray k v
+        | otherwise = Nothing
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE lookup #-}
+#endif
+
+-- | /O(log n)/ Return the value to which the specified key is mapped,
+-- or the default value if this map contains no mapping for the key.
+lookupDefault :: (Eq k, Hashable k)
+              => v          -- ^ Default value to return.
+              -> k -> HashMap k v -> v
+lookupDefault def k t = case lookup k t of
+    Just v -> v
+    _      -> def
+{-# INLINE lookupDefault #-}
+
+-- | Create a 'Collision' value with two 'Leaf' values.
+collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
+collision h e1 e2 =
+    let v = A.run $ do mary <- A.new 2 e1
+                       A.write mary 1 e2
+                       return mary
+    in Collision h v
+{-# INLINE collision #-}
+
+-- | Create a 'BitmapIndexed' or 'Full' node.
+bitmapIndexedOrFull :: Bitmap -> A.Array (HashMap k v) -> HashMap k v
+bitmapIndexedOrFull b ary
+    | b == fullNodeMask = Full ary
+    | otherwise         = BitmapIndexed b ary
+{-# INLINE bitmapIndexedOrFull #-}
+
+-- TODO: Use ptrEq to check if the value being inserted is the same
+-- and if so don't modify the tree at all.
+
+-- | /O(log n)/ Associate the specified value with the specified
+-- key in this map.  If this map previously contained a mapping for
+-- the key, the old value is replaced.
+insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
+insert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
+  where
+    h0 = hash k0
+    go !h !k x !_ Empty = return $! Leaf h (L k x)
+    go h k x s t@(Leaf hy l@(L ky y))
+        | hy == h = if ky == k
+                    then if x `ptrEq` y
+                         then return t
+                         else return $! Leaf h (L k x)
+                    else return $! collision h l (L k x)
+        | otherwise = two s h k x hy ky y
+    go h k x s (BitmapIndexed b ary)
+        | b .&. m == 0 = do
+            ary' <- A.insert' ary i $! Leaf h (L k x)
+            return $! bitmapIndexedOrFull (b .|. m) ary'
+        | otherwise = do
+            st <- A.index_ ary i
+            st' <- go h k x (s+bitsPerSubkey) st
+            ary' <- A.update' ary i st'
+            return $! BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k x s (Full ary) = do
+        st <- A.index_ ary i
+        st' <- go h k x (s+bitsPerSubkey) st
+        ary' <- update16' ary i st'
+        return $! Full ary'
+      where i = index h s
+    go h k x s t@(Collision hy v)
+        | h == hy   = return $! Collision h (updateOrSnocWith const k x v)
+        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE insert #-}
+#endif
+
+-- | Create a map from two key-value pairs which hashes don't collide.
+two :: Shift -> Hash -> k -> v -> Hash -> k -> v -> ST s (HashMap k v)
+two = go
+  where
+    go s h1 k1 v1 h2 k2 v2
+        | bp1 == bp2 = do
+            st <- go (s+bitsPerSubkey) h1 k1 v1 h2 k2 v2 
+            ary <- A.singleton' st
+            return $! BitmapIndexed bp1 ary
+        | otherwise  = do
+            mary <- A.new 2 $ Leaf h1 (L k1 v1)
+            A.write mary idx2 $ Leaf h2 (L k2 v2)
+            ary <- A.unsafeFreeze mary
+            return $! BitmapIndexed (bp1 .|. bp2) ary
+      where
+        bp1  = mask h1 s
+        bp2  = mask h2 s
+        idx2 | index h1 s < index h2 s = 1
+             | otherwise               = 0
+{-# INLINE two #-}
+
+-- | /O(log n)/ Associate the value with the key in this map.  If
+-- this map previously contained a mapping for the key, the old value
+-- is replaced by the result of applying the given function to the new
+-- and old value.  Example:
+--
+-- > insertWith f k v map
+-- >   where f new old = new + old
+insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
+            -> HashMap k v
+insertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
+  where
+    h0 = hash k0
+    go !h !k x !_ Empty = return $! Leaf h (L k x)
+    go h k x s (Leaf hy l@(L ky y))
+        | hy == h = if ky == k
+                    then return $! Leaf h (L k (f x y))
+                    else return $! collision h l (L k x)
+        | otherwise = two s h k x hy ky y
+    go h k x s (BitmapIndexed b ary)
+        | b .&. m == 0 = do
+            ary' <- A.insert' ary i $! Leaf h (L k x)
+            return $! bitmapIndexedOrFull (b .|. m) ary'
+        | otherwise = do
+            st <- A.index_ ary i
+            st' <- go h k x (s+bitsPerSubkey) st
+            ary' <- A.update' ary i st'
+            return $! BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k x s (Full ary) = do
+        st <- A.index_ ary i
+        st' <- go h k x (s+bitsPerSubkey) st
+        ary' <- update16' ary i st'
+        return $! Full ary'
+      where i = index h s
+    go h k x s t@(Collision hy v)
+        | h == hy   = return $! Collision h (updateOrSnocWith f k x v)
+        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE insertWith #-}
+#endif
+
+-- | /O(log n)/ Remove the mapping for the specified key from this map
+-- if present.
+delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
+delete k0 m0 = runST (go h0 k0 0 m0)
+  where
+    h0 = hash k0
+    go !_ !_ !_ Empty = return Empty
+    go h k _ t@(Leaf hy (L ky _))
+        | hy == h && ky == k = return Empty
+        | otherwise          = return t
+    go h k s t@(BitmapIndexed b ary)
+        | b .&. m == 0 = return t
+        | otherwise = do
+            let !st = A.index ary i
+            !st' <- go h k (s+bitsPerSubkey) st
+            if st' `ptrEq` st
+                then return t
+                else case st' of
+                Empty | A.length ary == 1 -> return Empty
+                      | otherwise -> do
+                          ary' <- A.delete' ary i
+                          return $! BitmapIndexed (b .&. complement m) ary'
+                _ -> do
+                    ary' <- A.update' ary i st'
+                    return $! BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k s t@(Full ary) = do
+        let !st = A.index ary i
+        !st' <- go h k (s+bitsPerSubkey) st
+        if st' `ptrEq` st
+            then return t
+            else case st' of
+            Empty -> do
+                ary' <- A.delete' ary i
+                return $! BitmapIndexed (mask h s) ary'
+            _ -> do
+                ary' <- A.update' ary i st'
+                return $! Full ary'
+      where i = index h s
+    go h k _ t@(Collision hy v)
+        | h == hy = case indexOf k v of
+            Just i
+                | A.length v == 2 ->
+                    if i == 0
+                    then return $! Leaf h (A.index v 1)
+                    else return $! Leaf h (A.index v 0)
+                | otherwise -> return $! Collision h (A.delete v i)
+            Nothing -> return t
+        | otherwise = return t
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE delete #-}
+#endif
+
+-- | /O(log n)/ Adjust the value tied to a given key in this map only
+-- if it is present. Otherwise, leave the map alone.
+adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
+adjust f k0 = go h0 k0 0
+  where
+    h0 = hash k0
+    go !_ !_ !_ Empty = Empty
+    go h k _ t@(Leaf hy (L ky y))
+        | hy == h && ky == k = Leaf h (L k (f y))
+        | otherwise          = t
+    go h k s t@(BitmapIndexed b ary)
+        | b .&. m == 0 = t
+        | otherwise = let st   = A.index ary i
+                          st'  = go h k (s+bitsPerSubkey) st
+                          ary' = A.update ary i $! st'
+                      in BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k s (Full ary) =
+        let i    = index h s
+            st   = A.index ary i
+            st'  = go h k (s+bitsPerSubkey) st
+            ary' = update16 ary i $! st'
+        in Full ary'
+    go h k _ t@(Collision hy v)
+        | h == hy   = Collision h (updateWith f k v)
+        | otherwise = t
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE adjust #-}
+#endif
+
+------------------------------------------------------------------------
+-- * Combine
+
+-- | /O(n+m)/ The union of two maps. If a key occurs in both maps, the
+-- mapping from the first will be the mapping in the result.
+union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v
+union = unionWith const
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE union #-}
+#endif
+
+-- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
+-- the provided function (first argument) will be used to compute the
+-- result.
+unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v
+          -> HashMap k v
+unionWith f = go 0
+  where
+    -- empty vs. anything
+    go !_ t1 Empty = t1
+    go _ Empty t2 = t2
+    -- leaf vs. leaf
+    go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = if k1 == k2
+                      then Leaf h1 (L k1 (f v1 v2))
+                      else collision h1 l1 l2
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2)
+        | h1 == h2  = Collision h1 (updateOrSnocWith f k1 v1 ls2)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2))
+        | h1 == h2  = Collision h1 (updateOrSnocWith (flip f) k2 v2 ls1)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)
+        | h1 == h2  = Collision h1 (updateOrConcatWith f ls1 ls2)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    -- branch vs. branch
+    go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
+        let b'   = b1 .|. b2
+            ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2
+        in bitmapIndexedOrFull b' ary'
+    go s (BitmapIndexed b1 ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2
+        in Full ary'
+    go s (Full ary1) (BitmapIndexed b2 ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2
+        in Full ary'
+    go s (Full ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask
+                   ary1 ary2
+        in Full ary'
+    -- leaf vs. branch
+    go s (BitmapIndexed b1 ary1) t2
+        | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
+                               b'   = b1 .|. m2
+                           in bitmapIndexedOrFull b' ary'
+        | otherwise      = let ary' = A.updateWith ary1 i $ \st1 ->
+                                   go (s+bitsPerSubkey) st1 t2
+                           in BitmapIndexed b1 ary'
+        where
+          h2 = leafHashCode t2
+          m2 = mask h2 s
+          i = sparseIndex b1 m2
+    go s t1 (BitmapIndexed b2 ary2)
+        | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
+                               b'   = b2 .|. m1
+                           in bitmapIndexedOrFull b' ary'
+        | otherwise      = let ary' = A.updateWith ary2 i $ \st2 ->
+                                   go (s+bitsPerSubkey) t1 st2
+                           in BitmapIndexed b2 ary'
+      where
+        h1 = leafHashCode t1
+        m1 = mask h1 s
+        i = sparseIndex b2 m1
+    go s (Full ary1) t2 =
+        let h2   = leafHashCode t2
+            i    = index h2 s
+            ary' = update16With ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2
+        in Full ary'
+    go s t1 (Full ary2) =
+        let h1   = leafHashCode t1
+            i    = index h1 s
+            ary' = update16With ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2
+        in Full ary'
+
+    leafHashCode (Leaf h _) = h
+    leafHashCode (Collision h _) = h
+    leafHashCode _ = error "leafHashCode"
+
+    goDifferentHash s h1 h2 t1 t2
+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)
+        | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
+        | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)
+      where
+        m1 = mask h1 s
+        m2 = mask h2 s
+{-# INLINE unionWith #-}
+
+-- | Strict in the result of @f@.
+unionArrayBy :: (a -> a -> a) -> Bitmap -> Bitmap -> A.Array a -> A.Array a
+             -> A.Array a
+unionArrayBy f b1 b2 ary1 ary2 = A.run $ do
+    let b' = b1 .|. b2
+    mary <- A.new_ (popCount b')
+    -- iterate over nonzero bits of b1 .|. b2
+    -- it would be nice if we could shift m by more than 1 each time
+    let hasBit b m = b .&. m /= 0
+        go !i !i1 !i2 !m
+            | m > b'                     = return ()
+            | hasBit b1 m && hasBit b2 m = do
+                A.write mary i $! f (A.index ary1 i1) (A.index ary2 i2)
+                go (i+1) (i1+1) (i2+1) (m `unsafeShiftL` 1)
+            | hasBit b1 m                = do
+                A.write mary i =<< A.index_ ary1 i1
+                go (i+1) (i1+1) (i2  ) (m `unsafeShiftL` 1)
+            | hasBit b2 m                = do
+                A.write mary i =<< A.index_ ary2 i2
+                go (i+1) (i1  ) (i2+1) (m `unsafeShiftL` 1)
+            | otherwise                  = go i i1 i2 (m `unsafeShiftL` 1)
+    go 0 0 0 1
+    return mary
+    -- TODO: For the case where b1 .&. b2 == b1, i.e. when one is a
+    -- subset of the other, we could use a slightly simpler algorithm,
+    -- where we copy one array, and then update.
+{-# INLINE unionArrayBy #-}
+
+------------------------------------------------------------------------
+-- * Transformations
+
+-- | /O(n)/ Transform this map by applying a function to every value.
+map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
+map f = go
+  where
+    go Empty = Empty
+    go (Leaf h (L k v)) = Leaf h $ L k (f v)
+    go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
+    go (Full ary) = Full $ A.map' go ary
+    go (Collision h ary) = Collision h $
+                           A.map' (\ (L k v) -> L k (f v)) ary
+{-# INLINE map #-}
+
+-- | /O(n)/ Transform this map by accumulating an Applicative result
+-- from every value.
+traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1
+                -> f (HashMap k v2)
+traverseWithKey f = go
+  where
+    go Empty                 = pure Empty
+    go (Leaf h (L k v))      = Leaf h . L k <$> f k v
+    go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse go ary
+    go (Full ary)            = Full <$> A.traverse go ary
+    go (Collision h ary)     =
+        Collision h <$> A.traverse (\ (L k v) -> L k <$> f k v) ary
+{-# INLINE traverseWithKey #-}
+
+------------------------------------------------------------------------
+-- * Difference and intersection
+
+-- | /O(n+m)/ Difference of two maps. Return elements of the first map
+-- not existing in the second.
+difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
+difference a b = foldlWithKey' go empty a
+  where
+    go m k v = case lookup k b of
+                 Nothing -> insert k v m
+                 _       -> m
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE difference #-}
+#endif
+
+-- | /O(n+m)/ Intersection of two maps. Return elements of the first
+-- map for keys existing in the second.
+intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
+intersection a b = foldlWithKey' go empty a
+  where
+    go m k v = case lookup k b of
+                 Just _ -> insert k v m
+                 _      -> m
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE intersection #-}
+#endif
+
+------------------------------------------------------------------------
+-- * Folds
+
+-- | /O(n)/ Reduce this map by applying a binary operator to all
+-- elements, using the given starting value (typically the
+-- left-identity of the operator).  Each application of the operator
+-- is evaluated before before using the result in the next
+-- application.  This function is strict in the starting value.
+foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
+foldl' f = foldlWithKey' (\ z _ v -> f z v)
+{-# INLINE foldl' #-}
+
+-- | /O(n)/ Reduce this map by applying a binary operator to all
+-- elements, using the given starting value (typically the
+-- left-identity of the operator).  Each application of the operator
+-- is evaluated before before using the result in the next
+-- application.  This function is strict in the starting value.
+foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
+foldlWithKey' f = go
+  where
+    go !z Empty                = z
+    go z (Leaf _ (L k v))      = f z k v
+    go z (BitmapIndexed _ ary) = A.foldl' go z ary
+    go z (Full ary)            = A.foldl' go z ary
+    go z (Collision _ ary)     = A.foldl' (\ z' (L k v) -> f z' k v) z ary
+{-# INLINE foldlWithKey' #-}
+
+-- | /O(n)/ Reduce this map by applying a binary operator to all
+-- elements, using the given starting value (typically the
+-- right-identity of the operator).
+foldr :: (v -> a -> a) -> a -> HashMap k v -> a
+foldr f = foldrWithKey (const f)
+{-# INLINE foldr #-}
+
+-- | /O(n)/ Reduce this map by applying a binary operator to all
+-- elements, using the given starting value (typically the
+-- right-identity of the operator).
+foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
+foldrWithKey f = go
+  where
+    go z Empty                 = z
+    go z (Leaf _ (L k v))      = f k v z
+    go z (BitmapIndexed _ ary) = A.foldr (flip go) z ary
+    go z (Full ary)            = A.foldr (flip go) z ary
+    go z (Collision _ ary)     = A.foldr (\ (L k v) z' -> f k v z') z ary
+{-# INLINE foldrWithKey #-}
+
+------------------------------------------------------------------------
+-- * Filter
+
+-- | Create a new array of the @n@ first elements of @mary@.
+trim :: A.MArray s a -> Int -> ST s (A.Array a)
+trim mary n = do
+    mary2 <- A.new_ n
+    A.copyM mary 0 mary2 0 n
+    A.unsafeFreeze mary2
+{-# INLINE trim #-}
+
+-- | /O(n)/ Filter this map by retaining only elements satisfying a
+-- predicate.
+filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v
+filterWithKey pred = go
+  where
+    go Empty = Empty
+    go t@(Leaf _ (L k v))
+        | pred k v  = t
+        | otherwise = Empty
+    go (BitmapIndexed b ary) = filterA ary b
+    go (Full ary) = filterA ary fullNodeMask
+    go (Collision h ary) = filterC ary h
+
+    filterA ary0 b0 =
+        let !n = A.length ary0
+        in runST $ do
+            mary <- A.new_ n
+            step ary0 mary b0 0 0 1 n
+      where
+        step !ary !mary !b i !j !bi n
+            | i >= n = case j of
+                0 -> return Empty
+                1 -> A.read mary 0
+                _ -> do
+                    ary2 <- trim mary j
+                    return $! if j == maxChildren
+                              then Full ary2
+                              else BitmapIndexed b ary2
+            | bi .&. b == 0 = step ary mary b i j (bi `unsafeShiftL` 1) n
+            | otherwise = case go (A.index ary i) of
+                Empty -> step ary mary (b .&. complement bi) (i+1) j
+                         (bi `unsafeShiftL` 1) n
+                t     -> do A.write mary j t
+                            step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
+
+    filterC ary0 h =
+        let !n = A.length ary0
+        in runST $ do
+            mary <- A.new_ n
+            step ary0 mary 0 0 n
+      where
+        step !ary !mary i !j n
+            | i >= n    = case j of
+                0 -> return Empty
+                1 -> do l <- A.read mary 0
+                        return $! Leaf h l
+                _ | i == j -> do ary2 <- A.unsafeFreeze mary
+                                 return $! Collision h ary2
+                  | otherwise -> do ary2 <- trim mary j
+                                    return $! Collision h ary2
+            | pred k v  = A.write mary j el >> step ary mary (i+1) (j+1) n
+            | otherwise = step ary mary (i+1) j n
+          where el@(L k v) = A.index ary i
+{-# INLINE filterWithKey #-}
+
+-- | /O(n)/ Filter this map by retaining only elements which values
+-- satisfy a predicate.
+filter :: (v -> Bool) -> HashMap k v -> HashMap k v
+filter p = filterWithKey (\_ v -> p v)
+{-# INLINE filter #-}
+
+------------------------------------------------------------------------
+-- * Conversions
+
+-- TODO: Improve fusion rules by modelled them after the Prelude ones
+-- on lists.
+
+-- | /O(n)/ Return a list of this map's keys.  The list is produced
+-- lazily.
+keys :: HashMap k v -> [k]
+keys = L.map fst . toList
+{-# INLINE keys #-}
+
+-- | /O(n)/ Return a list of this map's values.  The list is produced
+-- lazily.
+elems :: HashMap k v -> [v]
+elems = L.map snd . toList
+{-# INLINE elems #-}
+
+------------------------------------------------------------------------
+-- ** Lists
+
+-- | /O(n)/ Return a list of this map's elements.  The list is
+-- produced lazily.
+toList :: HashMap k v -> [(k, v)]
+#if defined(__GLASGOW_HASKELL__)
+toList t = build (\ c z -> foldrWithKey (curry c) z t)
+#else
+toList = foldrWithKey (\ k v xs -> (k, v) : xs) []
+#endif
+{-# INLINE toList #-}
+
+-- | /O(n)/ Construct a map with the supplied mappings.  If the list
+-- contains duplicate mappings, the later mappings take precedence.
+fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v
+fromList = L.foldl' (\ m (k, v) -> insert k v m) empty
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE fromList #-}
+#endif
+
+-- | /O(n*log n)/ Construct a map from a list of elements.  Uses
+-- the provided function to merge duplicate entries.
+fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
+fromListWith f = L.foldl' (\ m (k, v) -> insertWith f k v m) empty
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINE fromListWith #-}
+#endif
+
+------------------------------------------------------------------------
+-- Array operations
+
+-- | /O(n)/ Lookup the value associated with the given key in this
+-- array.  Returns 'Nothing' if the key wasn't found.
+lookupInArray :: Eq k => k -> A.Array (Leaf k v) -> Maybe v
+lookupInArray k0 ary0 = go k0 ary0 0 (A.length ary0)
+  where
+    go !k !ary !i !n
+        | i >= n    = Nothing
+        | otherwise = case A.index ary i of
+            (L kx v)
+                | k == kx   -> Just v
+                | otherwise -> go k ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE lookupInArray #-}
+#endif
+
+-- | /O(n)/ Lookup the value associated with the given key in this
+-- array.  Returns 'Nothing' if the key wasn't found.
+indexOf :: Eq k => k -> A.Array (Leaf k v) -> Maybe Int
+indexOf k0 ary0 = go k0 ary0 0 (A.length ary0)
+  where
+    go !k !ary !i !n
+        | i >= n    = Nothing
+        | otherwise = case A.index ary i of
+            (L kx _)
+                | k == kx   -> Just i
+                | otherwise -> go k ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE indexOf #-}
+#endif
+
+updateWith :: Eq k => (v -> v) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
+updateWith f k0 ary0 = go k0 ary0 0 (A.length ary0)
+  where
+    go !k !ary !i !n
+        | i >= n    = ary
+        | otherwise = case A.index ary i of
+            (L kx y) | k == kx   -> A.update ary i (L k (f y))
+                     | otherwise -> go k ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE updateWith #-}
+#endif
+
+updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v)
+                 -> A.Array (Leaf k v)
+updateOrSnocWith f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0)
+  where
+    go !k v !ary !i !n
+        | i >= n = A.run $ do
+            -- Not found, append to the end.
+            mary <- A.new_ (n + 1)
+            A.copy ary 0 mary 0 n
+            A.write mary n (L k v)
+            return mary
+        | otherwise = case A.index ary i of
+            (L kx y) | k == kx   -> A.update ary i (L k (f v y))
+                     | otherwise -> go k v ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE updateOrSnocWith #-}
+#endif
+
+updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
+updateOrConcatWith f ary1 ary2 = A.run $ do
+    -- first: look up the position of each element of ary2 in ary1
+    let indices = A.map (\(L k _) -> indexOf k ary1) ary2
+    -- that tells us how large the overlap is:
+    -- count number of Nothing constructors
+    let nOnly2 = A.foldl' (\n -> maybe (n+1) (const n)) 0 indices
+    let n1 = A.length ary1
+    let n2 = A.length ary2
+    -- copy over all elements from ary1
+    mary <- A.new_ (n1 + nOnly2)
+    A.copy ary1 0 mary 0 n1
+    -- append or update all elements from ary2
+    let go !iEnd !i2
+          | i2 >= n2 = return ()
+          | otherwise = case A.index indices i2 of
+               Just i1 -> do -- key occurs in both arrays, store combination in position i1
+                             L k v1 <- A.index_ ary1 i1
+                             L _ v2 <- A.index_ ary2 i2
+                             A.write mary i1 (L k (f v1 v2))
+                             go iEnd (i2+1)
+               Nothing -> do -- key is only in ary2, append to end
+                             A.write mary iEnd =<< A.index_ ary2 i2
+                             go (iEnd+1) (i2+1)
+    go n1 0
+    return mary
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE updateOrConcatWith #-}
+#endif
+
+------------------------------------------------------------------------
+-- Manually unrolled loops
+
+-- | /O(n)/ Update the element at the given position in this array.
+update16 :: A.Array e -> Int -> e -> A.Array e
+update16 ary idx b = runST (update16' ary idx b)
+{-# INLINE update16 #-}
+
+-- | /O(n)/ Update the element at the given position in this array.
+update16' :: A.Array e -> Int -> e -> ST s (A.Array e)
+update16' ary idx b = do
+    mary <- clone16 ary
+    A.write mary idx b
+    A.unsafeFreeze mary
+{-# INLINE update16' #-}
+
+-- | /O(n)/ Update the element at the given position in this array, by applying a function to it.
+update16With :: A.Array e -> Int -> (e -> e) -> A.Array e
+update16With ary idx f = update16 ary idx $! f (A.index ary idx)
+{-# INLINE update16With #-}
+
+-- | Unsafely clone an array of 16 elements.  The length of the input
+-- array is not checked.
+clone16 :: A.Array e -> ST s (A.MArray s e)
+clone16 ary =
+#if __GLASGOW_HASKELL__ >= 702
+    A.thaw ary 0 16
+#else
+    do mary <- A.new_ 16
+       A.index_ ary 0 >>= A.write mary 0
+       A.index_ ary 1 >>= A.write mary 1
+       A.index_ ary 2 >>= A.write mary 2
+       A.index_ ary 3 >>= A.write mary 3
+       A.index_ ary 4 >>= A.write mary 4
+       A.index_ ary 5 >>= A.write mary 5
+       A.index_ ary 6 >>= A.write mary 6
+       A.index_ ary 7 >>= A.write mary 7
+       A.index_ ary 8 >>= A.write mary 8
+       A.index_ ary 9 >>= A.write mary 9
+       A.index_ ary 10 >>= A.write mary 10
+       A.index_ ary 11 >>= A.write mary 11
+       A.index_ ary 12 >>= A.write mary 12
+       A.index_ ary 13 >>= A.write mary 13
+       A.index_ ary 14 >>= A.write mary 14
+       A.index_ ary 15 >>= A.write mary 15
+       return mary
+#endif
+
+------------------------------------------------------------------------
+-- Bit twiddling
+
+bitsPerSubkey :: Int
+bitsPerSubkey = 4
+
+maxChildren :: Int
+maxChildren = fromIntegral $ 1 `unsafeShiftL` bitsPerSubkey
+
+subkeyMask :: Bitmap
+subkeyMask = 1 `unsafeShiftL` bitsPerSubkey - 1
+
+sparseIndex :: Bitmap -> Bitmap -> Int
+sparseIndex b m = popCount (b .&. (m - 1))
+
+mask :: Word -> Shift -> Bitmap
+mask w s = 1 `unsafeShiftL` index w s
+{-# INLINE mask #-}
+
+-- | Mask out the 'bitsPerSubkey' bits used for indexing at this level
+-- of the tree.
+index :: Hash -> Shift -> Int
+index w s = fromIntegral $ (unsafeShiftR w s) .&. subkeyMask
+{-# INLINE index #-}
+
+-- | A bitmask with the 'bitsPerSubkey' least significant bits set.
+fullNodeMask :: Bitmap
+fullNodeMask = complement (complement 0 `unsafeShiftL`
+                           fromIntegral (1 `unsafeShiftL` bitsPerSubkey))
+{-# INLINE fullNodeMask #-}
+
+-- | Check if two the two arguments are the same value.  N.B. This
+-- function might give false negatives (due to GC moving objects.)
+ptrEq :: a -> a -> Bool
+#if defined(__GLASGOW_HASKELL__)
+ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#
+#else
+ptrEq _ _ = False
+#endif
+{-# INLINE ptrEq #-}
diff --git a/Data/HashMap/Common.hs b/Data/HashMap/Common.hs
deleted file mode 100644
--- a/Data/HashMap/Common.hs
+++ /dev/null
@@ -1,338 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable #-}
-
--- | Code shared between the lazy and strict versions.
-
-module Data.HashMap.Common
-    (
-      -- * Types
-      HashMap(..)
-
-      -- * Helpers
-    , join
-    , bin
-    , zero
-    , nomatch
-
-    -- * Construction
-    , empty
-
-    -- * Combine
-    , union
-
-    -- * Transformations
-    , toList
-    , filterMapWithKey
-    , traverseWithKey
-
-    -- * Folds
-    , foldrWithKey
-
-    -- * Helpers
-    , shorter
-    , insertCollidingWith
-    ) where
-
-#include "MachDeps.h"
-
-import Control.Applicative (Applicative((<*>), pure), (<$>))
-import Control.DeepSeq (NFData(rnf))
-import Data.Bits (Bits(..), (.&.), xor)
-import qualified Data.Foldable as Foldable
-import Data.Monoid (Monoid(mempty, mappend))
-import Data.Traversable (Traversable(..))
-import Data.Typeable (Typeable)
-import Data.Word (Word)
-import Prelude hiding (foldr, map)
-
-#if defined(__GLASGOW_HASKELL__)
-import GHC.Exts (build)
-#endif
-
-import qualified Data.FullList.Lazy as FL
-
-------------------------------------------------------------------------
--- * The 'HashMap' type
-
--- | A map from keys to values.  A map cannot contain duplicate keys;
--- each key can map to at most one value.
-data HashMap k v
-    = Bin {-# UNPACK #-} !SuffixMask
-          !(HashMap k v)
-          !(HashMap k v)
-    | Tip {-# UNPACK #-} !Hash
-          {-# UNPACK #-} !(FL.FullList k v)
-    | Nil
-    deriving (Typeable)
-
-type Suffix = Int
-type Hash   = Int
-
--- | A SuffixMask stores a path to a Bin node in the hash map.  The
--- uppermost set bit, the Mask, indicates the bit used to distinguish
--- hashes in the left and right subtrees.  The lower-order bits (below
--- the highest set bit), the Suffix, are set the same way in all the
--- hashes contained in this subtree of the map.  Thus, hashes in the
--- right subtree will match all the bits in the SuffixMask, but may
--- have set bits above the Mask.  Hashes in the left subtree will not
--- match the Mask bit, but will match all the Suffix bits.
-type SuffixMask = Int
-
-------------------------------------------------------------------------
--- * Instances
-
--- Since both the lazy and the strict API shares one data type we can
--- only provide one set of instances.  We provide the lazy ones.
-
-instance (Eq k, Eq v) => Eq (HashMap k v) where
-    t1 == t2 = equal t1 t2
-    t1 /= t2 = nequal t1 t2
-
--- | /O(n)/ Return a list of this map's elements.  The list is
--- produced lazily.
-toList :: HashMap k v -> [(k, v)]
-#if defined(__GLASGOW_HASKELL__)
-toList t = build (\ c z -> foldrWithKey (curry c) z t)
-#else
-toList = foldrWithKey (\ k v xs -> (k, v) : xs) []
-#endif
-{-# INLINE toList #-}
-
-equal :: (Eq k, Eq v) => HashMap k v -> HashMap k v -> Bool
-equal (Bin sm1 l1 r1) (Bin sm2 l2 r2) =
-    (sm1 == sm2) && (equal l1 l2) && (equal r1 r2)
-equal (Tip h1 l1) (Tip h2 l2) = (h1 == h2) && (l1 == l2)
-equal Nil Nil = True
-equal _   _   = False
-
-nequal :: (Eq k, Eq v) => HashMap k v -> HashMap k v -> Bool
-nequal (Bin sm1 l1 r1) (Bin sm2 l2 r2) =
-    (sm1 /= sm2) || (nequal l1 l2) || (nequal r1 r2)
-nequal (Tip h1 l1) (Tip h2 l2) = (h1 /= h2) || (l1 /= l2)
-nequal Nil Nil = False
-nequal _   _   = True
-
-instance (NFData k, NFData v) => NFData (HashMap k v) where
-    rnf Nil           = ()
-    rnf (Tip _ xs)    = rnf xs
-    rnf (Bin _ l r) = rnf l `seq` rnf r
-
-instance Functor (HashMap k) where
-    fmap = map
-
-instance (Show k, Show v) => Show (HashMap k v) where
-    showsPrec d m = showParen (d > 10) $
-      showString "fromList " . shows (toList m)
-
--- | /O(n)/ Transform this map by applying a function to every value.
-map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
-map f = go
-  where
-    go (Bin sm l r) = Bin sm (go l) (go r)
-    go (Tip h l)    = Tip h (FL.map f' l)
-    go Nil          = Nil
-    f' k v = (k, f v)
-{-# INLINE map #-}
-
-instance Foldable.Foldable (HashMap k) where
-    foldr f = foldrWithKey (const f)
-
--- | /O(n)/ Reduce this map by applying a binary operator to all
--- elements, using the given starting value (typically the
--- right-identity of the operator).
-foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
-foldrWithKey f = go
-  where
-    go z (Bin _ l r) = go (go z r) l
-    go z (Tip _ l)   = FL.foldrWithKey f z l
-    go z Nil         = z
-{-# INLINE foldrWithKey #-}
-
-instance Eq k => Monoid (HashMap k v) where
-  mempty = empty
-  {-# INLINE mempty #-}
-  mappend = union
-  {-# INLINE mappend #-}
-
--- | /O(1)/ Construct an empty map.
-empty :: HashMap k v
-empty = Nil
-
--- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
--- the mapping from the first will be the mapping in the result.
-union :: Eq k => HashMap k v -> HashMap k v -> HashMap k v
-union t1@(Bin sm1 l1 r1) t2@(Bin sm2 l2 r2)
-    | sm1 == sm2      = Bin sm1 (union l1 l2) (union r1 r2)
-    | shorter sm1 sm2 = union1
-    | shorter sm2 sm1 = union2
-    | otherwise       = join sm1 t1 sm2 t2
-  where
-    union1 | nomatch sm2 sm1 = join sm1 t1 sm2 t2
-           | zero sm2 sm1    = Bin sm1 (union l1 t2) r1
-           | otherwise       = Bin sm1 l1 (union r1 t2)
-
-    union2 | nomatch sm1 sm2 = join sm1 t1 sm2 t2
-           | zero sm1 sm2    = Bin sm2 (union t1 l2) r2
-           | otherwise       = Bin sm2 l2 (union t1 r2)
-union (Tip h l) t = insertCollidingL h l t
-union t (Tip h l) = insertCollidingR h l t  -- right bias
-union Nil t       = t
-union t Nil       = t
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE union #-}
-#endif
-
--- | Insert a list of key-value pairs which keys all hash to the same
--- hash value.  Prefer key-value pairs in the list to key-value pairs
--- already in the map.
-insertCollidingL :: Eq k => Hash -> FL.FullList k v -> HashMap k v -> HashMap k v
-insertCollidingL = insertCollidingWith FL.union
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertCollidingL #-}
-#endif
-
--- | Insert a list of key-value pairs which keys all hash to the same
--- hash value.  Prefer key-value pairs already in the map to key-value
--- pairs in the list.
-insertCollidingR :: Eq k => Hash -> FL.FullList k v -> HashMap k v -> HashMap k v
-insertCollidingR = insertCollidingWith (flip FL.union)
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertCollidingR #-}
-#endif
-
--- | Insert a list of key-value pairs which keys all hash to the same
--- hash value.  Merge the list of key-value pairs to be inserted @xs@
--- with any existing key-values pairs @ys@ by applying @f xs ys@.
-insertCollidingWith :: Eq k
-                    => (FL.FullList k v -> FL.FullList k v -> FL.FullList k v)
-                    -> Hash -> FL.FullList k v
-                    -> HashMap k v -> HashMap k v
-insertCollidingWith f h0 l0 t0 = go h0 l0 t0
-  where
-    go !h !xs t@(Bin sm l r)
-        | nomatch h sm = join h (Tip h xs) sm t
-        | zero h sm    = Bin sm (go h xs l) r
-        | otherwise    = Bin sm l (go h xs r)
-    go h xs t@(Tip h' l)
-        | h == h'       = Tip h $ f xs l
-        | otherwise     = join h (Tip h xs) h' t
-    go h xs Nil         = Tip h xs
-{-# INLINE insertCollidingWith #-}
-
-instance Traversable (HashMap k) where
-  traverse f = traverseWithKey (const f)
-
--- | /O(n)/ Transform this map by applying a function to every value;
--- when f k v returns Just x, keep an entry mapping k to x, otherwise
--- do not include k in the result.
-filterMapWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
-filterMapWithKey f = go
-  where
-    go (Bin sm l r) = bin sm (go l) (go r)
-    go (Tip h vs) =
-      case FL.foldrWithKey ff FL.Nil vs of
-        FL.Nil -> Nil
-        FL.Cons k v xs -> Tip h (FL.FL k v xs)
-    go Nil = Nil
-    ff k v xs =
-      case f k v of
-        Nothing -> xs
-        Just x  -> FL.Cons k x xs
-{-# INLINE filterMapWithKey #-}
-
--- | /O(n)/ Transform this map by accumulating an Applicative result
--- from every value.
-traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1
-                -> f (HashMap k v2)
-traverseWithKey f = go
-  where
-    go (Bin sm l r) = Bin sm <$> go l <*> go r
-    go (Tip h l) = Tip h <$> FL.traverseWithKey f l
-    go Nil = pure Nil
-{-# INLINE traverseWithKey #-}
-
-------------------------------------------------------------------------
--- Helpers
-
-join :: Suffix -> HashMap k v -> Suffix -> HashMap k v -> HashMap k v
-join s1 t1 s2 t2
-    | zero s1 sm = Bin sm t1 t2
-    | otherwise  = Bin sm t2 t1
-  where
-    sm = branchSuffixMask s1 s2
-{-# INLINE join #-}
-
--- | @bin@ assures that we never have empty trees within a tree.
-bin :: SuffixMask -> HashMap k v -> HashMap k v -> HashMap k v
-bin _ l Nil = l
-bin _ Nil r = r
-bin sm  l r = Bin sm l r
-{-# INLINE bin #-}
-
-------------------------------------------------------------------------
--- Endian independent bit twiddling
-
--- Actually detects if every set bit of sm is set in i (and returns
--- false if so).  In most cases, the Suffix will already match, and
--- this just tests the Mask.  For lookup it can send us down the wrong
--- path, but that's OK; we'll detect this when we reach a Tip and
--- don't match.  We could have checked (i .|. fromIntegral sm) /= i
--- instead.
-zero :: Hash -> SuffixMask -> Bool
-zero i sm = (i .&. smi) /= smi
-  where smi = fromIntegral sm
-{-# INLINE zero #-}
-
--- We want to detect Suffix bits in the Hash that differ from
--- SuffixMask.  To do this, we find the first bit that differs between
--- Hash and SuffixMask, then check if that bit is smaller than the
--- Mask bit.  We do this by observing that if we set this bit and all
--- bits to its right, we'll obtain a number >= the suffixmask if all
--- bits are the same (cb == 0, setting all bits) or if the first bit of
--- difference is >= the Mask.  Note: this comparison must be unsigned.
-nomatch :: Hash -> SuffixMask -> Bool
-nomatch i sm = (cb + cb - 1) < fromIntegral sm
-  where cb = differentBit i (fromIntegral sm)
-{-# INLINE nomatch #-}
-
-------------------------------------------------------------------------
--- Big endian operations
-
--- | Compute the first (lowest-order) bit at which h1 and h2 differ.
--- This is the mask that distinguishes them.
-differentBit :: Hash -> Hash -> Word
-differentBit h1 h2 =
-  fromIntegral (critBit (fromIntegral h1 `xor` fromIntegral h2))
-
--- | Given mask bit m expressed as a word, compute the suffix bits of
--- hash i, also expressed as a word.
-suffixW :: Word -> Word -> Word
-suffixW i m = i .&. (m-1)
-{-# INLINE suffixW #-}
-
--- | Given two hashes and/or SuffixMasks for which nomatch p1 p2 &&
--- nomatch p2 p1, compute SuffixMask that differentiates them, by
--- first computing the mask m and then using that to derive a suffix
--- from one of them (it won't matter which, as those bits are the
--- same).
-branchSuffixMask :: Suffix -> Suffix -> SuffixMask
-branchSuffixMask p1 p2 =
-    fromIntegral (m + suffixW w1 m)
-  where m = differentBit p1 p2
-        w1 = fromIntegral p1
-{-# INLINE branchSuffixMask #-}
-
--- | Is the mask of sm1 closer to the root of the tree (lower order)
--- than the mask of sm2?  This is actually approximate, and returns
--- junk when both sm1 and sm2 are at the same tree level.  This must
--- be disambiguated by first checking sm1==sm2, and subsequently by
--- checking nomatch in the appropriate direction (which will need to
--- happen anyway to determine if insertion or branching is
--- appropriate).
-shorter :: SuffixMask -> SuffixMask -> Bool
-shorter sm1 sm2 = (fromIntegral sm1 :: Word) < (fromIntegral sm2 :: Word)
-{-# INLINE shorter #-}
-
--- | Return a 'Word' whose single set bit corresponds to the lowest set bit of w.
-critBit :: Word -> Word
-critBit w = w .&. (negate w)
-{-# INLINE critBit #-}
diff --git a/Data/HashMap/Lazy.hs b/Data/HashMap/Lazy.hs
--- a/Data/HashMap/Lazy.hs
+++ b/Data/HashMap/Lazy.hs
@@ -1,9 +1,13 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE CPP #-}
 
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.HashMap.Lazy
--- Copyright   :  2010-2011 Johan Tibell
+-- Copyright   :  2010-2012 Johan Tibell
 -- License     :  BSD-style
 -- Maintainer  :  johan.tibell@gmail.com
 -- Stability   :  provisional
@@ -17,16 +21,14 @@
 -- evaluated to /weak head normal form/ before they are added to the
 -- map.
 --
--- The implementation is based on /big-endian patricia trees/, keyed
--- by a hash of the original key.  A 'HashMap' is often faster than
--- other tree-based maps, especially when key comparison is expensive,
--- as in the case of strings.
+-- The implementation is based on /hash array mapped tries/.  A
+-- 'HashMap' is often faster than other tree-based set types,
+-- especially when key comparison is expensive, as in the case of
+-- strings.
 --
--- Many operations have a worst-case complexity of /O(min(n,W))/.
--- This means that the operation can become linear in the number of
--- elements with a maximum of /W/ -- the number of bits in an 'Int'
--- (32 or 64).
-
+-- Many operations have a average-case complexity of /O(log n)/.  The
+-- implementation uses a large base (i.e. 16) so in practice these
+-- operations are constant time.
 module Data.HashMap.Lazy
     (
       HashMap
@@ -36,13 +38,13 @@
     , singleton
 
       -- * Basic interface
-    , null
+    , HM.null
     , size
-    , lookup
+    , HM.lookup
     , lookupDefault
     , insert
-    , delete
     , insertWith
+    , delete
     , adjust
 
       -- * Combine
@@ -51,7 +53,7 @@
     , unionWith
 
       -- * Transformations
-    , map
+    , HM.map
     , traverseWithKey
 
       -- * Difference and intersection
@@ -61,16 +63,16 @@
       -- * Folds
     , foldl'
     , foldlWithKey'
-    , foldr
+    , HM.foldr
     , foldrWithKey
 
       -- * Filter
-    , filter
+    , HM.filter
     , filterWithKey
 
       -- * Conversions
-    , elems
     , keys
+    , elems
 
       -- ** Lists
     , toList
@@ -78,283 +80,4 @@
     , fromListWith
     ) where
 
-import qualified Data.FullList.Lazy as FL
-import Data.Hashable (Hashable(hash))
-import qualified Data.List as List
-import Prelude hiding (filter, foldr, lookup, map, null, pred)
-
-import Data.HashMap.Common
-
-------------------------------------------------------------------------
--- * Basic interface
-
--- | /O(1)/ Return 'True' if this map is empty, 'False' otherwise.
-null :: HashMap k v -> Bool
-null Nil = True
-null _   = False
-
--- | /O(n)/ Return the number of key-value mappings in this map.
-size :: HashMap k v -> Int
-size t = go t 0
-  where
-    go (Bin _ l r) !sz = go r (go l sz)
-    go (Tip _ l)   !sz = sz + FL.size l
-    go Nil         !sz = sz
-
--- | /O(min(n,W))/ Return the value to which the specified key is
--- mapped, or 'Nothing' if this map contains no mapping for the key.
-lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
-lookup k0 t = go h0 k0 t
-  where
-    h0 = hash k0
-    go !h !k (Bin sm l r)
-      | zero h sm = go h k l
-      | otherwise = go h k r
-    go h k (Tip h' l)
-      | h == h'   = FL.lookup k l
-      | otherwise = Nothing
-    go _ _ Nil    = Nothing
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE lookup #-}
-#endif
-
--- | /O(min(n,W))/ Return the value to which the specified key is
--- mapped, or the default value if this map contains no mapping for
--- the key.
-lookupDefault :: (Eq k, Hashable k)
-              => v          -- ^ Default value to return.
-              -> k -> HashMap k v -> v
-lookupDefault def k t = case lookup k t of
-                          Just v -> v
-                          _      -> def
-{-# INLINABLE lookupDefault #-}
-
--- | /O(1)/ Construct a map with a single element.
-singleton :: Hashable k => k -> v -> HashMap k v
-singleton k v = Tip h $ FL.singleton k v
-  where h = hash k
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE singleton #-}
-#endif
-
--- | /O(min(n,W))/ Associate the specified value with the specified
--- key in this map.  If this map previously contained a mapping for
--- the key, the old value is replaced.
-insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
-insert k0 v0 t0 = go h0 k0 v0 t0
-  where
-    h0 = hash k0
-    go !h !k v t@(Bin sm l r)
-        | nomatch h sm = join h (Tip h $ FL.singleton k v) sm t
-        | zero h sm    = Bin sm (go h k v l) r
-        | otherwise    = Bin sm l (go h k v r)
-    go h k v t@(Tip h' l)
-        | h == h'      = Tip h $ FL.insert k v l
-        | otherwise    = join h (Tip h $ FL.singleton k v) h' t
-    go h k v Nil       = Tip h $ FL.singleton k v
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insert #-}
-#endif
-
--- | /O(min(n,W))/ Remove the mapping for the specified key from this
--- map if present.
-delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
-delete k0 = go h0 k0
-  where
-    h0 = hash k0
-    go !h !k t@(Bin sm l r)
-        | nomatch h sm = t
-        | zero h sm    = bin sm (go h k l) r
-        | otherwise    = bin sm l (go h k r)
-    go h k t@(Tip h' l)
-        | h == h'       = case FL.delete k l of
-            Nothing -> Nil
-            Just l' -> Tip h' l'
-        | otherwise     = t
-    go _ _ Nil          = Nil
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE delete #-}
-#endif
-
--- | /O(min(n,W))/ Associate the value with the key in this map.  If
--- this map previously contained a mapping for the key, the old value
--- is replaced by the result of applying the given function to the new
--- and old value.  Example:
---
--- > insertWith f k v map
--- >   where f new old = new + old
-insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
-           -> HashMap k v
-insertWith f k0 v0 t0 = go h0 k0 v0 t0
-  where
-    h0 = hash k0
-    go !h !k v t@(Bin sm l r)
-        | nomatch h sm = join h (Tip h $ FL.singleton k v) sm t
-        | zero h sm    = Bin sm (go h k v l) r
-        | otherwise    = Bin sm l (go h k v r)
-    go h k v t@(Tip h' l)
-        | h == h'       = Tip h $ FL.insertWith f k v l
-        | otherwise     = join h (Tip h $ FL.singleton k v) h' t
-    go h k v Nil        = Tip h $ FL.singleton k v
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE insertWith #-}
-#endif
-
--- | /O(min(n,W)/ Adjust the value tied to a given key in this map
--- only if it is present. Otherwise, leave the map alone.
-adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
-adjust f k0 t0 = go h0 k0 t0
-  where
-    h0 = hash k0
-    go !h !k t@(Bin sm l r)
-      | nomatch h sm = t
-      | zero h sm    = Bin sm (go h k l) r
-      | otherwise    = Bin sm l (go h k r)
-    go h k t@(Tip h' l)
-      | h == h'      = Tip h $ FL.adjust f k l
-      | otherwise    = t
-    go _ _ Nil       = Nil
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE adjust #-}
-#endif
-
-------------------------------------------------------------------------
--- * Transformations
-
--- | /O(n)/ Transform this map by applying a function to every value.
-map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
-map f = go
-  where
-    go (Bin sm l r) = Bin sm (go l) (go r)
-    go (Tip h l)    = Tip h (FL.map f' l)
-    go Nil          = Nil
-    f' k v = (k, f v)
-{-# INLINE map #-}
-
--- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
--- the provided function (first argument) will be used to compute the result.
-unionWith :: Eq k => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
-unionWith f t1@(Bin sm1 l1 r1) t2@(Bin sm2 l2 r2)
-    | sm1 == sm2      = Bin sm1 (unionWith f l1 l2) (unionWith f r1 r2)
-    | shorter sm1 sm2 = union1
-    | shorter sm2 sm1 = union2
-    | otherwise       = join sm1 t1 sm2 t2
-  where
-    union1 | nomatch sm2 sm1 = join sm1 t1 sm2 t2
-           | zero sm2 sm1    = Bin sm1 (unionWith f l1 t2) r1
-           | otherwise       = Bin sm1 l1 (unionWith f r1 t2)
-
-    union2 | nomatch sm1 sm2 = join sm1 t1 sm2 t2
-           | zero sm1 sm2    = Bin sm2 (unionWith f t1 l2) r2
-           | otherwise       = Bin sm2 l2 (unionWith f t1 r2)
-unionWith f (Tip h l) t = insertCollidingWith (FL.unionWith f) h l t
-unionWith f t (Tip h l) = insertCollidingWith (flip (FL.unionWith f)) h l t  -- right bias
-unionWith _ Nil t       = t
-unionWith _ t Nil       = t
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWith #-}
-#endif
-
--- | /O(n)/ Difference of two maps. Return elements of the first map
--- not existing in the second.
-difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
-difference a b = foldlWithKey' go empty a
-  where
-    go m k v = case lookup k b of
-                 Nothing -> insert k v m
-                 _       -> m
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE difference #-}
-#endif
-
--- | /O(n)/ Intersection of two maps. Return elements of the first map
--- for keys existing in the second.
-intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
-intersection a b = foldlWithKey' go empty a
-  where
-    go m k v = case lookup k b of
-                 Just _ -> insert k v m
-                 _      -> m
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE intersection #-}
-#endif
-
-------------------------------------------------------------------------
--- * Folds
-
--- | /O(n)/ Reduce this map by applying a binary operator to all
--- elements, using the given starting value (typically the
--- right-identity of the operator).
-foldr :: (v -> a -> a) -> a -> HashMap k v -> a
-foldr f = foldrWithKey (const f)
-{-# INLINE foldr #-}
-
--- | /O(n)/ Reduce this map by applying a binary operator to all
--- elements, using the given starting value (typically the
--- left-identity of the operator).  Each application of the operator
--- is evaluated before before using the result in the next
--- application.  This function is strict in the starting value.
-foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
-foldl' f = foldlWithKey' (\ z _ v -> f z v)
-{-# INLINE foldl' #-}
-
--- | /O(n)/ Reduce this map by applying a binary operator to all
--- elements, using the given starting value (typically the
--- left-identity of the operator).  Each application of the operator
--- is evaluated before before using the result in the next
--- application.  This function is strict in the starting value.
-foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
-foldlWithKey' f = go
-  where
-    go !z (Bin _ l r) = let z' = go z l
-                        in z' `seq` go z' r
-    go z (Tip _ l)    = FL.foldlWithKey' f z l
-    go z Nil          = z
-{-# INLINE foldlWithKey' #-}
-
-------------------------------------------------------------------------
--- * Filter
-
--- | /O(n)/ Filter this map by retaining only elements satisfying a
--- predicate.
-filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v
-filterWithKey pred = go
-  where
-    go (Bin sm l r) = bin sm (go l) (go r)
-    go (Tip h l)    = case FL.filterWithKey pred l of
-        Just l' -> Tip h l'
-        Nothing -> Nil
-    go Nil          = Nil
-{-# INLINE filterWithKey #-}
-
--- | /O(n)/ Filter this map by retaining only elements which values
--- satisfy a predicate.
-filter :: (v -> Bool) -> HashMap k v -> HashMap k v
-filter p = filterWithKey (\_ v -> p v)
-{-# INLINE filter #-}
-
-------------------------------------------------------------------------
--- Conversions
-
--- | /O(n*min(W, n))/ Construct a map from a list of elements.
-fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v
-fromList = List.foldl' (\ m (k, v) -> insert k v m) empty
-{-# INLINE fromList #-}
-
--- | /O(n*min(W, n))/ Construct a map from a list of elements.  Uses
--- the provided function to merge duplicate entries.
-fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
-fromListWith f = List.foldl' (\ m (k, v) -> insertWith f k v m) empty
-{-# INLINE fromListWith #-}
-
--- | /O(n)/ Return a list of this map's keys.  The list is produced
--- lazily.
-keys :: HashMap k v -> [k]
-keys = List.map fst . toList
-{-# INLINE keys #-}
-
--- | /O(n)/ Return a list of this map's values.  The list is produced
--- lazily.
-elems :: HashMap k v -> [v]
-elems = List.map snd . toList
-{-# INLINE elems #-}
+import Data.HashMap.Base as HM
diff --git a/Data/HashMap/Lazy/Internal.hs b/Data/HashMap/Lazy/Internal.hs
deleted file mode 100644
--- a/Data/HashMap/Lazy/Internal.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-
-------------------------------------------------------------------------
--- |
--- Module      :  Data.HashMap.Lazy.Internal
--- Copyright   :  2010-2011 Johan Tibell
--- License     :  BSD-style
--- Maintainer  :  johan.tibell@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- Semi-public internals.
-
-module Data.HashMap.Lazy.Internal
-    ( collisions
-    , collisionHistogram
-    ) where
-
-import Prelude hiding (lookup)
-
-import qualified Data.FullList.Lazy as FL
-import Data.HashMap.Common (HashMap(..))
-import Data.HashMap.Lazy (insert, lookup)
-
--------------------------------------------------------------------
--- Metadata about map behavior
-
--- | /O(n)/ Return the number of hash collisions in this map.
-collisions :: HashMap k v -> Int
-collisions t = go t 0
-  where
-    go (Bin _ l r) !sz = go r (go l sz)
-    go (Tip _ l)     !sz
-      | fl_sz <= 1 = sz
-      | otherwise  = sz + fl_sz
-      where fl_sz = FL.size l
-    go Nil           !sz = sz
-
--- | /O(n)/ Return histogram of hash collisions in this map.
--- Keys are number of entries in bucket, values are number of buckets
--- of that size.
-collisionHistogram :: HashMap k v -> HashMap Int Int
-collisionHistogram t = go t Nil
-  where
-    go (Bin _ l r) h = go r (go l h)
-    go (Tip _ l)     h = (insert sz $! maybe 1 (1+) (lookup sz h)) h
-      where sz = FL.size l
-    go Nil           h = h
diff --git a/Data/HashMap/PopCount.hs b/Data/HashMap/PopCount.hs
new file mode 100644
--- /dev/null
+++ b/Data/HashMap/PopCount.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Data.HashMap.PopCount
+    ( popCount
+    ) where
+
+#if __GLASGOW_HASKELL__ >= 704
+import Data.Bits (popCount)
+#else
+import Data.Word (Word)
+import Foreign.C (CUInt)
+#endif
+
+#if __GLASGOW_HASKELL__ < 704
+foreign import ccall unsafe "popc.h popcount" c_popcount :: CUInt -> CUInt
+
+popCount :: Word -> Int
+popCount w = fromIntegral (c_popcount (fromIntegral w))
+#endif
diff --git a/Data/HashMap/Strict.hs b/Data/HashMap/Strict.hs
--- a/Data/HashMap/Strict.hs
+++ b/Data/HashMap/Strict.hs
@@ -1,9 +1,13 @@
 {-# LANGUAGE BangPatterns, CPP #-}
 
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.HashMap.Strict
--- Copyright   :  2010-2011 Johan Tibell
+-- Copyright   :  2010-2012 Johan Tibell
 -- License     :  BSD-style
 -- Maintainer  :  johan.tibell@gmail.com
 -- Stability   :  provisional
@@ -18,16 +22,14 @@
 -- the map.  Exception: the provided instances are the same as for the
 -- lazy version of this module.
 --
--- The implementation is based on /big-endian patricia trees/, keyed
--- by a hash of the original key.  A 'HashMap' is often faster than
--- other tree-based maps, especially when key comparison is expensive,
--- as in the case of strings.
+-- The implementation is based on /hash array mapped tries/.  A
+-- 'HashMap' is often faster than other tree-based set types,
+-- especially when key comparison is expensive, as in the case of
+-- strings.
 --
--- Many operations have a worst-case complexity of /O(min(n,W))/.
--- This means that the operation can become linear in the number of
--- elements with a maximum of /W/ -- the number of bits in an 'Int'
--- (32 or 64).
-
+-- Many operations have a average-case complexity of /O(log n)/.  The
+-- implementation uses a large base (i.e. 16) so in practice these
+-- operations are constant time.
 module Data.HashMap.Strict
     (
       HashMap
@@ -37,13 +39,13 @@
     , singleton
 
       -- * Basic interface
-    , null
+    , HM.null
     , size
-    , lookup
+    , HM.lookup
     , lookupDefault
     , insert
-    , delete
     , insertWith
+    , delete
     , adjust
 
       -- * Combine
@@ -62,16 +64,16 @@
       -- * Folds
     , foldl'
     , foldlWithKey'
-    , foldr
+    , HM.foldr
     , foldrWithKey
 
       -- * Filter
-    , filter
+    , HM.filter
     , filterWithKey
 
       -- * Conversions
-    , elems
     , keys
+    , elems
 
       -- ** Lists
     , toList
@@ -79,44 +81,38 @@
     , fromListWith
     ) where
 
-import Data.Hashable (Hashable(hash))
-import Prelude hiding (filter, foldr, lookup, map, null)
+import Control.Monad.ST (runST)
+import Data.Bits ((.&.), (.|.))
+import qualified Data.List as L
+import Data.Hashable (Hashable)
+import Prelude hiding (map)
 
-import qualified Data.FullList.Strict as FL
-import Data.HashMap.Common
-import Data.HashMap.Lazy hiding (fromList, fromListWith, insert, insertWith,
-                                 adjust, map, singleton, unionWith)
-import qualified Data.HashMap.Lazy as L
-import qualified Data.List as List
+import qualified Data.HashMap.Array as A
+import qualified Data.HashMap.Base as HM
+import Data.HashMap.Base hiding (
+    adjust, fromList, fromListWith, insert, insertWith, map, singleton,
+    unionWith)
 
 ------------------------------------------------------------------------
--- * Basic interface
+-- * Construction
 
 -- | /O(1)/ Construct a map with a single element.
-singleton :: Hashable k => k -> v -> HashMap k v
-singleton k !v = L.singleton k v
-{-# INLINE singleton #-}
+singleton :: (Hashable k) => k -> v -> HashMap k v
+singleton k !v = HM.singleton k v
 
--- | /O(min(n,W))/ Associate the specified value with the specified
+------------------------------------------------------------------------
+-- * Basic interface
+
+-- | /O(log n)/ Associate the specified value with the specified
 -- key in this map.  If this map previously contained a mapping for
 -- the key, the old value is replaced.
 insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
-insert k0 !v0 t0 = go h0 k0 v0 t0
-  where
-    h0 = hash k0
-    go !h !k v t@(Bin sm l r)
-        | nomatch h sm = join h (Tip h $ FL.singleton k v) sm t
-        | zero h sm    = Bin sm (go h k v l) r
-        | otherwise    = Bin sm l (go h k v r)
-    go h k v t@(Tip h' l)
-        | h == h'      = Tip h $ FL.insert k v l
-        | otherwise    = join h (Tip h $ FL.singleton k v) h' t
-    go h k v Nil       = Tip h $ FL.singleton k v
+insert k !v = HM.insert k v
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insert #-}
 #endif
 
--- | /O(min(n,W))/ Associate the value with the key in this map.  If
+-- | /O(log n)/ Associate the value with the key in this map.  If
 -- this map previously contained a mapping for the key, the old value
 -- is replaced by the result of applying the given function to the new
 -- and old value.  Example:
@@ -125,40 +121,159 @@
 -- >   where f new old = new + old
 insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
            -> HashMap k v
-insertWith f k0 !v0 t0 = go h0 k0 v0 t0
+insertWith f k0 !v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
-    go !h !k v t@(Bin sm l r)
-        | nomatch h sm = join h (Tip h $ FL.singleton k v) sm t
-        | zero h sm    = Bin sm (go h k v l) r
-        | otherwise    = Bin sm l (go h k v r)
-    go h k v t@(Tip h' l)
-        | h == h'      = Tip h $ FL.insertWith f k v l
-        | otherwise    = join h (Tip h $ FL.singleton k v) h' t
-    go h k v Nil       = Tip h $ FL.singleton k v
+    go !h !k x !_ Empty = return $ Leaf h (L k x)
+    go h k x s (Leaf hy l@(L ky y))
+        | hy == h = if ky == k
+                    then let !v' = f x y in return $! Leaf h (L k v')
+                    else return $! collision h l (L k x)
+        | otherwise = two s h k x hy ky y
+    go h k x s (BitmapIndexed b ary)
+        | b .&. m == 0 = do
+            ary' <- A.insert' ary i $! Leaf h (L k x)
+            return $! bitmapIndexedOrFull (b .|. m) ary'
+        | otherwise = do
+            st <- A.index_ ary i
+            st' <- go h k x (s+bitsPerSubkey) st
+            ary' <- A.update' ary i st'
+            return $! BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k x s (Full ary) = do
+        st <- A.index_ ary i
+        st' <- go h k x (s+bitsPerSubkey) st
+        ary' <- update16' ary i st'
+        return $! Full ary'
+      where i = index h s
+    go h k x s t@(Collision hy v)
+        | h == hy   = return $! Collision h (updateOrSnocWith f k x v)
+        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertWith #-}
 #endif
 
--- | /O(min(n,W)/ Adjust the value tied to a given key in this map
--- only if it is present. Otherwise, leave the map alone.
+-- | /O(log n)/ Adjust the value tied to a given key in this map only
+-- if it is present. Otherwise, leave the map alone.
 adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
-adjust f k0 t0 = go h0 k0 t0
+adjust f k0 = go h0 k0 0
   where
     h0 = hash k0
-    go !h !k t@(Bin sm l r)
-      | nomatch h sm = t
-      | zero h sm    = Bin sm (go h k l) r
-      | otherwise    = Bin sm l (go h k r)
-    go h k t@(Tip h' l)
-      | h == h'      = Tip h $ FL.adjust f k l
-      | otherwise    = t
-    go _ _ Nil       = Nil
+    go !_ !_ !_ Empty = Empty
+    go h k _ t@(Leaf hy (L ky y))
+        | hy == h && ky == k = let !v' = f y in Leaf h (L k v')
+        | otherwise          = t
+    go h k s t@(BitmapIndexed b ary)
+        | b .&. m == 0 = t
+        | otherwise = let st   = A.index ary i
+                          st'  = go h k (s+bitsPerSubkey) st
+                          ary' = A.update ary i $! st'
+                      in BitmapIndexed b ary'
+      where m = mask h s
+            i = sparseIndex b m
+    go h k s (Full ary) =
+        let i    = index h s
+            st   = A.index ary i
+            st'  = go h k (s+bitsPerSubkey) st
+            ary' = update16 ary i $! st'
+        in Full ary'
+    go h k _ t@(Collision hy v)
+        | h == hy   = Collision h (updateWith f k v)
+        | otherwise = t
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE adjust #-}
 #endif
 
+------------------------------------------------------------------------
+-- * Combine
 
+-- | /O(n*log m)/ The union of two maps.  If a key occurs in both maps,
+-- the provided function (first argument) will be used to compute the result.
+unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v
+          -> HashMap k v
+unionWith f = go 0
+  where
+    -- empty vs. anything
+    go !_ t1 Empty = t1
+    go _ Empty t2 = t2
+    -- leaf vs. leaf
+    go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = if k1 == k2
+                      then Leaf h1 . L k1 $! f v1 v2
+                      else collision h1 l1 l2
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2)
+        | h1 == h2  = Collision h1 (updateOrSnocWith f k1 v1 ls2)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2))
+        | h1 == h2  = Collision h1 (updateOrSnocWith (flip f) k2 v2 ls1)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)
+        | h1 == h2  = Collision h1 (updateOrConcatWith f ls1 ls2)
+        | otherwise = goDifferentHash s h1 h2 t1 t2
+    -- branch vs. branch
+    go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
+        let b'   = b1 .|. b2
+            ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2
+        in bitmapIndexedOrFull b' ary'
+    go s (BitmapIndexed b1 ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2
+        in Full ary'
+    go s (Full ary1) (BitmapIndexed b2 ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2
+        in Full ary'
+    go s (Full ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask
+                   ary1 ary2
+        in Full ary'
+    -- leaf vs. branch
+    go s (BitmapIndexed b1 ary1) t2
+        | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
+                               b'   = b1 .|. m2
+                           in bitmapIndexedOrFull b' ary'
+        | otherwise      = let ary' = A.updateWith ary1 i $ \st1 ->
+                                   go (s+bitsPerSubkey) st1 t2
+                           in BitmapIndexed b1 ary'
+        where
+          h2 = leafHashCode t2
+          m2 = mask h2 s
+          i = sparseIndex b1 m2
+    go s t1 (BitmapIndexed b2 ary2)
+        | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
+                               b'   = b2 .|. m1
+                           in bitmapIndexedOrFull b' ary'
+        | otherwise      = let ary' = A.updateWith ary2 i $ \st2 ->
+                                   go (s+bitsPerSubkey) t1 st2
+                           in BitmapIndexed b2 ary'
+      where
+        h1 = leafHashCode t1
+        m1 = mask h1 s
+        i = sparseIndex b2 m1
+    go s (Full ary1) t2 =
+        let h2   = leafHashCode t2
+            i    = index h2 s
+            ary' = update16With ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2
+        in Full ary'
+    go s t1 (Full ary2) =
+        let h1   = leafHashCode t1
+            i    = index h1 s
+            ary' = update16With ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2
+        in Full ary'
+
+    leafHashCode (Leaf h _) = h
+    leafHashCode (Collision h _) = h
+    leafHashCode _ = error "leafHashCode"
+
+    goDifferentHash s h1 h2 t1 t2
+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)
+        | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
+        | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)
+      where
+        m1 = mask h1 s
+        m2 = mask h2 s
+{-# INLINE unionWith #-}
+
 ------------------------------------------------------------------------
 -- * Transformations
 
@@ -166,46 +281,63 @@
 map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
 map f = go
   where
-    go (Bin sm l r) = Bin sm (go l) (go r)
-    go (Tip h l)    = Tip h (FL.map f' l)
-    go Nil          = Nil
-    f' k v = (k, f v)
+    go Empty                 = Empty
+    go (Leaf h (L k v))      = let !v' = f v in Leaf h $ L k v'
+    go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
+    go (Full ary)            = Full $ A.map' go ary
+    go (Collision h ary)     =
+        Collision h $ A.map' (\ (L k v) -> let !v' = f v in L k v') ary
 {-# INLINE map #-}
 
--- | /O(n+m)/ The union of two maps.  If a key occurs in both maps,
--- the provided function (first argument) will be used to compute the result.
-unionWith :: Eq k => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
-unionWith f t1@(Bin sm1 l1 r1) t2@(Bin sm2 l2 r2)
-    | sm1 == sm2      = Bin sm1 (unionWith f l1 l2) (unionWith f r1 r2)
-    | shorter sm1 sm2 = union1
-    | shorter sm2 sm1 = union2
-    | otherwise       = join sm1 t1 sm2 t2
-  where
-    union1 | nomatch sm2 sm1 = join sm1 t1 sm2 t2
-           | zero sm2 sm1    = Bin sm1 (unionWith f l1 t2) r1
-           | otherwise       = Bin sm1 l1 (unionWith f r1 t2)
-
-    union2 | nomatch sm1 sm2 = join sm1 t1 sm2 t2
-           | zero sm1 sm2    = Bin sm2 (unionWith f t1 l2) r2
-           | otherwise       = Bin sm2 l2 (unionWith f t1 r2)
-unionWith f (Tip h l) t = insertCollidingWith (FL.unionWith f) h l t
-unionWith f t (Tip h l) = insertCollidingWith (flip (FL.unionWith f)) h l t  -- right bias
-unionWith _ Nil t       = t
-unionWith _ t Nil       = t
-#if __GLASGOW_HASKELL__ >= 700
-{-# INLINABLE unionWith #-}
-#endif
+-- TODO: Should we add a strict traverseWithKey?
 
 ------------------------------------------------------------------------
--- Conversions
+-- ** Lists
 
--- | /O(n*min(W, n))/ Construct a map from a list of elements.
+-- | /O(n*log n)/ Construct a map with the supplied mappings.  If the
+-- list contains duplicate mappings, the later mappings take
+-- precedence.
 fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v
-fromList = List.foldl' (\ m (k, v) -> insert k v m) empty
-{-# INLINE fromList #-}
+fromList = L.foldl' (\ m (k, v) -> insert k v m) empty
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE fromList #-}
+#endif
 
--- | /O(n*min(W, n))/ Construct a map from a list of elements.  Uses
+-- | /O(n*log n)/ Construct a map from a list of elements.  Uses
 -- the provided function to merge duplicate entries.
 fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
-fromListWith f = List.foldl' (\ m (k, v) -> insertWith f k v m) empty
+fromListWith f = L.foldl' (\ m (k, v) -> insertWith f k v m) empty
 {-# INLINE fromListWith #-}
+
+------------------------------------------------------------------------
+-- Array operations
+
+updateWith :: Eq k => (v -> v) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
+updateWith f k0 ary0 = go k0 ary0 0 (A.length ary0)
+  where
+    go !k !ary !i !n
+        | i >= n    = ary
+        | otherwise = case A.index ary i of
+            (L kx y) | k == kx   -> let !v' = f y in A.update ary i (L k v')
+                     | otherwise -> go k ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE updateWith #-}
+#endif
+
+updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v)
+                 -> A.Array (Leaf k v)
+updateOrSnocWith f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0)
+  where
+    go !k v !ary !i !n
+        | i >= n = A.run $ do
+            -- Not found, append to the end.
+            mary <- A.new_ (n + 1)
+            A.copy ary 0 mary 0 n
+            A.write mary n (L k v)
+            return mary
+        | otherwise = case A.index ary i of
+            (L kx y) | k == kx   -> let !v' = f v y in A.update ary i (L k v')
+                     | otherwise -> go k v ary (i+1) n
+#if __GLASGOW_HASKELL__ >= 700
+{-# INLINABLE updateOrSnocWith #-}
+#endif
diff --git a/Data/HashMap/Strict/Internal.hs b/Data/HashMap/Strict/Internal.hs
deleted file mode 100644
--- a/Data/HashMap/Strict/Internal.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-
-------------------------------------------------------------------------
--- |
--- Module      :  Data.HashMap.Strict.Internal
--- Copyright   :  2010-2011 Johan Tibell
--- License     :  BSD-style
--- Maintainer  :  johan.tibell@gmail.com
--- Stability   :  provisional
--- Portability :  portable
---
--- Semi-public internals.
-
-module Data.HashMap.Strict.Internal
-    ( collisions
-    , collisionHistogram
-    ) where
-
-import Data.HashMap.Lazy.Internal
diff --git a/Data/HashMap/UnsafeShift.hs b/Data/HashMap/UnsafeShift.hs
new file mode 100644
--- /dev/null
+++ b/Data/HashMap/UnsafeShift.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash #-}
+
+module Data.HashMap.UnsafeShift
+    ( unsafeShiftL
+    , unsafeShiftR
+    ) where
+
+import GHC.Exts (Word(W#), Int(I#), uncheckedShiftL#, uncheckedShiftRL#)
+
+unsafeShiftL :: Word -> Int -> Word
+unsafeShiftL (W# x#) (I# i#) = W# (x# `uncheckedShiftL#` i#)
+{-# INLINE unsafeShiftL #-}
+
+unsafeShiftR :: Word -> Int -> Word
+unsafeShiftR (W# x#) (I# i#) = W# (x# `uncheckedShiftRL#` i#)
+{-# INLINE unsafeShiftR #-}
diff --git a/Data/HashSet.hs b/Data/HashSet.hs
--- a/Data/HashSet.hs
+++ b/Data/HashSet.hs
@@ -12,15 +12,14 @@
 -- A set of /hashable/ values.  A set cannot contain duplicate items.
 -- A 'HashSet' makes no guarantees as to the order of its elements.
 --
--- The implementation is based on /big-endian patricia trees/, indexed
--- by a hash of the original value.  A 'HashSet' is often faster than
--- other tree-based set types, especially when value comparison is
--- expensive, as in the case of strings.
+-- The implementation is based on /hash array mapped trie/.  A
+-- 'HashSet' is often faster than other tree-based set types,
+-- especially when value comparison is expensive, as in the case of
+-- strings.
 --
--- Many operations have a worst-case complexity of /O(min(n,W))/.
--- This means that the operation can become linear in the number of
--- elements with a maximum of /W/ -- the number of bits in an 'Int'
--- (32 or 64).
+-- Many operations have a average-case complexity of /O(log n)/.  The
+-- implementation uses a large base (i.e. 16) so in practice these
+-- operations are constant time.
 
 module Data.HashSet
     (
@@ -60,7 +59,7 @@
     ) where
 
 import Control.DeepSeq (NFData(..))
-import Data.HashMap.Common (HashMap, foldrWithKey)
+import Data.HashMap.Base (HashMap, foldrWithKey)
 import Data.Hashable (Hashable)
 import Data.Monoid (Monoid(..))
 import Prelude hiding (filter, foldr, map, null)
diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs
deleted file mode 100644
--- a/benchmarks/Benchmarks.hs
+++ /dev/null
@@ -1,232 +0,0 @@
-{-# LANGUAGE GADTs #-}
-
-module Main where
-
-import Control.DeepSeq
-import Control.Exception (evaluate)
-import Control.Monad.Trans (liftIO)
-import Criterion.Config
-import Criterion.Main
-import Data.Bits ((.&.))
-import Data.Hashable (Hashable)
-import qualified Data.ByteString as BS
-import qualified Data.HashMap.Strict as HM
-import qualified Data.IntMap as IM
-import qualified Data.Map as M
-import Data.List (foldl')
-import Data.Maybe (fromMaybe)
-import Prelude hiding (lookup)
-
-import qualified Util.ByteString as UBS
-import qualified Util.Int as UI
-import qualified Util.String as US
-
-instance NFData BS.ByteString
-
-data B where
-    B :: NFData a => a -> B
-
-instance NFData B where
-    rnf (B b) = rnf b
-
-main :: IO ()
-main = do
-    let hm   = HM.fromList elems :: HM.HashMap String Int
-        hmbs = HM.fromList elemsBS :: HM.HashMap BS.ByteString Int
-        hmi  = HM.fromList elemsI :: HM.HashMap Int Int
-        hmi2 = HM.fromList elemsI2 :: HM.HashMap Int Int
-        m    = M.fromList elems :: M.Map String Int
-        mbs  = M.fromList elemsBS :: M.Map BS.ByteString Int
-        im   = IM.fromList elemsI :: IM.IntMap Int
-    defaultMainWith defaultConfig
-        (liftIO . evaluate $ rnf [B m, B mbs, B hm, B hmbs, B hmi, B im])
-        [
-          -- * Comparison to other data structures
-          -- ** Map
-          bgroup "Map"
-          [ bgroup "lookup"
-            [ bench "String" $ whnf (lookupM keys) m
-            , bench "ByteString" $ whnf (lookupM keysBS) mbs
-            ]
-          , bgroup "lookup-miss"
-            [ bench "String" $ whnf (lookupM keys') m
-            , bench "ByteString" $ whnf (lookupM keysBS') mbs
-            ]
-          , bgroup "insert"
-            [ bench "String" $ whnf (insertM elems) M.empty
-            , bench "ByteStringString" $ whnf (insertM elemsBS) M.empty
-            ]
-          , bgroup "insert-dup"
-            [ bench "String" $ whnf (insertM elems) m
-            , bench "ByteStringString" $ whnf (insertM elemsBS) mbs
-            ]
-          , bgroup "delete"
-            [ bench "String" $ whnf (deleteM keys) m
-            , bench "ByteString" $ whnf (deleteM keysBS) mbs
-            ]
-          , bgroup "delete-miss"
-            [ bench "String" $ whnf (deleteM keys') m
-            , bench "ByteString" $ whnf (deleteM keysBS') mbs
-            ]
-          , bgroup "size"
-            [ bench "String" $ whnf M.size m
-            , bench "ByteString" $ whnf M.size mbs
-            ]
-          , bgroup "fromList"
-            [ bench "String" $ whnf M.fromList elems
-            , bench "ByteString" $ whnf M.fromList elemsBS
-            ]
-          ]
-
-          -- ** IntMap
-        , bgroup "IntMap"
-          [ bench "lookup" $ whnf (lookupIM keysI) im
-          , bench "lookup-miss" $ whnf (lookupIM keysI') im
-          , bench "insert" $ whnf (insertIM elemsI) IM.empty
-          , bench "insert-dup" $ whnf (insertIM elemsI) im
-          , bench "delete" $ whnf (deleteIM keysI) im
-          , bench "delete-miss" $ whnf (deleteIM keysI') im
-          , bench "size" $ whnf IM.size im
-          , bench "fromList" $ whnf IM.fromList elemsI
-          ]
-
-          -- * Basic interface
-        , bgroup "lookup"
-          [ bench "String" $ whnf (lookup keys) hm
-          , bench "ByteString" $ whnf (lookup keysBS) hmbs
-          , bench "Int" $ whnf (lookup keysI) hmi
-          ]
-        , bgroup "lookup-miss"
-          [ bench "String" $ whnf (lookup keys') hm
-          , bench "ByteString" $ whnf (lookup keysBS') hmbs
-          , bench "Int" $ whnf (lookup keysI') hmi
-          ]
-        , bgroup "insert"
-          [ bench "String" $ whnf (insert elems) HM.empty
-          , bench "ByteString" $ whnf (insert elemsBS) HM.empty
-          , bench "Int" $ whnf (insert elemsI) HM.empty
-          ]
-        , bgroup "insert-dup"
-          [ bench "String" $ whnf (insert elems) hm
-          , bench "ByteString" $ whnf (insert elemsBS) hmbs
-          , bench "Int" $ whnf (insert elemsI) hmi
-          ]
-        , bgroup "delete"
-          [ bench "String" $ whnf (delete keys) hm
-          , bench "ByteString" $ whnf (delete keysBS) hmbs
-          , bench "Int" $ whnf (delete keysI) hmi
-          ]
-        , bgroup "delete-miss"
-          [ bench "String" $ whnf (delete keys') hm
-          , bench "ByteString" $ whnf (delete keysBS') hmbs
-          , bench "Int" $ whnf (delete keysI') hmi
-          ]
-
-          -- Combine
-        , bench "union" $ whnf (HM.union hmi) hmi2
-
-          -- Transformations
-        , bench "map" $ whnf (HM.map (\ v -> v + 1)) hmi
-
-          -- * Difference and intersection
-        , bench "difference" $ whnf (HM.difference hmi) hmi2
-        , bench "intersection" $ whnf (HM.intersection hmi) hmi2
-
-          -- Folds
-        , bench "foldl'" $ whnf (HM.foldl' (+) 0) hmi
-        , bench "foldr" $ whnf (HM.foldr (:) []) hmi
-
-          -- Filter
-        , bench "filter" $ whnf (HM.filter (\ v -> v .&. 1 == 0)) hmi
-        , bench "filterWithKey" $ whnf (HM.filterWithKey (\ k _ -> k .&. 1 == 0)) hmi
-
-          -- Size
-        , bgroup "size"
-          [ bench "String" $ whnf HM.size hm
-          , bench "ByteString" $ whnf HM.size hmbs
-          , bench "Int" $ whnf HM.size hmi
-          ]
-
-          -- fromList
-        , bgroup "fromList"
-          [ bench "String" $ whnf HM.fromList elems
-          , bench "ByteString" $ whnf HM.fromList elemsBS
-          , bench "Int" $ whnf HM.fromList elemsI
-          ]
-        ]
-  where
-    n :: Int
-    n = 2^(12 :: Int)
-
-    elems   = zip keys [1..n]
-    keys    = US.rnd 8 n
-    elemsBS = zip keysBS [1..n]
-    keysBS  = UBS.rnd 8 n
-    elemsI  = zip keysI [1..n]
-    keysI   = UI.rnd (n+n) n
-    elemsI2 = zip [n `div` 2..n + (n `div` 2)] [1..n]  -- for union
-
-    keys'    = US.rnd' 8 n
-    keysBS'  = UBS.rnd' 8 n
-    keysI'   = UI.rnd' (n+n) n
-
-------------------------------------------------------------------------
--- * HashMap
-
-lookup :: (Eq k, Hashable k) => [k] -> HM.HashMap k Int -> Int
-lookup xs m = foldl' (\z k -> fromMaybe z (HM.lookup k m)) 0 xs
-{-# SPECIALIZE lookup :: [Int] -> HM.HashMap Int Int -> Int #-}
-{-# SPECIALIZE lookup :: [String] -> HM.HashMap String Int -> Int #-}
-{-# SPECIALIZE lookup :: [BS.ByteString] -> HM.HashMap BS.ByteString Int
-                      -> Int #-}
-
-insert :: (Eq k, Hashable k) => [(k, Int)] -> HM.HashMap k Int
-       -> HM.HashMap k Int
-insert xs m0 = foldl' (\m (k, v) -> HM.insert k v m) m0 xs
-{-# SPECIALIZE insert :: [(Int, Int)] -> HM.HashMap Int Int
-                      -> HM.HashMap Int Int #-}
-{-# SPECIALIZE insert :: [(String, Int)] -> HM.HashMap String Int
-                      -> HM.HashMap String Int #-}
-{-# SPECIALIZE insert :: [(BS.ByteString, Int)] -> HM.HashMap BS.ByteString Int
-                      -> HM.HashMap BS.ByteString Int #-}
-
-delete :: (Eq k, Hashable k) => [k] -> HM.HashMap k Int -> HM.HashMap k Int
-delete xs m0 = foldl' (\m k -> HM.delete k m) m0 xs
-{-# SPECIALIZE delete :: [Int] -> HM.HashMap Int Int -> HM.HashMap Int Int #-}
-{-# SPECIALIZE delete :: [String] -> HM.HashMap String Int
-                      -> HM.HashMap String Int #-}
-{-# SPECIALIZE delete :: [BS.ByteString] -> HM.HashMap BS.ByteString Int
-                      -> HM.HashMap BS.ByteString Int #-}
-
-------------------------------------------------------------------------
--- * 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 :: [BS.ByteString] -> M.Map BS.ByteString 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 :: [(BS.ByteString, Int)] -> M.Map BS.ByteString Int
-                       -> M.Map BS.ByteString 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 :: [BS.ByteString] -> M.Map BS.ByteString Int
-                       -> M.Map BS.ByteString Int #-}
-
-------------------------------------------------------------------------
--- * 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/benchmarks/Makefile b/benchmarks/Makefile
deleted file mode 100644
--- a/benchmarks/Makefile
+++ /dev/null
@@ -1,45 +0,0 @@
-ghc-prof-flags :=
-ifdef ENABLE_PROFILING
-	ghc-prof-flags += -prof -hisuf p_hi -osuf p_o
-	lib-suffix := _p
-else
-	lib-suffix :=
-endif
-
-ghc := ghc
-extra-ghc-flags :=
-
-package := unordered-containers
-version := $(shell awk '/^version:/{print $$2}' ../$(package).cabal)
-lib := ../dist/build/libHS$(package)-$(version)$(lib-suffix).a
-ghc-flags := -Wall -O2 -hide-all-packages \
-	-package-conf ../dist/package.conf.inplace -package base -package mtl \
-	-package unordered-containers -package containers -package criterion \
-	-package deepseq -package hashable -package random -package bytestring \
-	$(ghc-prof-flags) -rtsopts
-ghc-flags += $(extra-ghc-flags)
-criterion-flags :=
-
-%.o: %.hs
-	$(ghc) $(ghc-flags) -c -o $@ $<
-
-programs := bench
-
-.PHONY: all
-all: $(programs)
-
-bench: $(lib) Benchmarks.o Util/Int.o Util/ByteString.o Util/String.o
-	ranlib $(lib)
-	$(ghc) $(ghc-flags) -threaded -o $@ $(filter %.o,$^) $(lib)
-
-.PHONY: bench-all
-bench-all: bench
-	./bench $(criterion-flags) +RTS -H -RTS `./bench -l | sed 's/ *\(.*\)/\1/' | grep -v "Benchmarks:\|IntMap\|Map"`
-
-.PHONY: clean
-clean:
-	-find . \( -name '*.o' -o -name '*.hi' \) -exec rm {} \;
-	-rm -f $(programs)
-
-Benchmarks.o: Util/Int.o Util/ByteString.o Util/String.o
-Util/ByteString.o: Util/String.o
diff --git a/benchmarks/Util/ByteString.hs b/benchmarks/Util/ByteString.hs
deleted file mode 100644
--- a/benchmarks/Util/ByteString.hs
+++ /dev/null
@@ -1,29 +0,0 @@
--- | Benchmarking utilities.  For example, functions for generating
--- random 'ByteString's.
-module Util.ByteString where
-
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Char8 as C
-
-import Util.String as String
-
--- | Generate a number of fixed length 'ByteString's where the content
--- of the strings are letters in ascending order.
-asc :: Int  -- ^ Length of each string
-    -> Int  -- ^ Number of strings
-    -> [S.ByteString]
-asc strlen num = map C.pack $ String.asc strlen num
-
--- | Generate a number of fixed length 'ByteString's where the content
--- of the strings are letters in random order.
-rnd :: Int  -- ^ Length of each string
-    -> Int  -- ^ Number of strings
-    -> [S.ByteString]
-rnd strlen num = map C.pack $ String.rnd strlen num
-
--- | Generate a number of fixed length 'ByteString's where the content
--- of the strings are letters in random order, different from @rnd@.
-rnd' :: Int  -- ^ Length of each string
-     -> Int  -- ^ Number of strings
-     -> [S.ByteString]
-rnd' strlen num = map C.pack $ String.rnd' strlen num
diff --git a/benchmarks/Util/Int.hs b/benchmarks/Util/Int.hs
deleted file mode 100644
--- a/benchmarks/Util/Int.hs
+++ /dev/null
@@ -1,19 +0,0 @@
--- | Benchmarking utilities.  For example, functions for generating
--- random integers.
-module Util.Int where
-
-import System.Random (mkStdGen, randomRs)
-
--- | Generate a number of uniform random integers in the interval
--- @[0..upper]@.
-rnd :: Int  -- ^ Upper bound (inclusive)
-    -> Int  -- ^ Number of integers
-    -> [Int]
-rnd upper num = take num $ randomRs (0, upper) $ mkStdGen 1234
-
--- | Generate a number of uniform random integers in the interval
--- @[0..upper]@ different from @rnd@.
-rnd' :: Int  -- ^ Upper bound (inclusive)
-     -> Int  -- ^ Number of integers
-     -> [Int]
-rnd' upper num = take num $ randomRs (0, upper) $ mkStdGen 5678
diff --git a/benchmarks/Util/String.hs b/benchmarks/Util/String.hs
deleted file mode 100644
--- a/benchmarks/Util/String.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | Benchmarking utilities.  For example, functions for generating
--- random strings.
-module Util.String where
-
-import System.Random (mkStdGen, randomRs)
-
--- | Generate a number of fixed length strings where the content of
--- the strings are letters in ascending order.
-asc :: Int  -- ^ Length of each string
-    -> Int  -- ^ Number of strings
-    -> [String]
-asc strlen num = take num $ iterate (snd . inc) $ replicate strlen 'a'
-  where inc [] = (True, [])
-        inc (c:cs) = case inc cs of (True, cs') | c == 'z'  -> (True, 'a' : cs')
-                                                | otherwise -> (False, succ c : cs')
-                                    (False, cs')            -> (False, c : cs')
-
--- | Generate a number of fixed length strings where the content of
--- the strings are letters in random order.
-rnd :: Int  -- ^ Length of each string
-    -> Int  -- ^ Number of strings
-    -> [String]
-rnd strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 1234
-  where
-    split cs = case splitAt strlen cs of (str, cs') -> str : split cs'
-
--- | Generate a number of fixed length strings where the content of
--- the strings are letters in random order, different from rnd
-rnd' :: Int  -- ^ Length of each string
-     -> Int  -- ^ Number of strings
-     -> [String]
-rnd' strlen num = take num $ split $ randomRs ('a', 'z') $ mkStdGen 5678
-  where
-    split cs = case splitAt strlen cs of (str, cs') -> str : split cs'
diff --git a/cbits/popc.c b/cbits/popc.c
new file mode 100644
--- /dev/null
+++ b/cbits/popc.c
@@ -0,0 +1,273 @@
+#include <inttypes.h>
+
+/* Cribbed from http://wiki.cs.pdx.edu/forge/popcount.html */
+static char popcount_table_8[256] = {
+  /*0*/ 0,
+  /*1*/ 1,
+  /*2*/ 1,
+  /*3*/ 2,
+  /*4*/ 1,
+  /*5*/ 2,
+  /*6*/ 2,
+  /*7*/ 3,
+  /*8*/ 1,
+  /*9*/ 2,
+  /*10*/ 2,
+  /*11*/ 3,
+  /*12*/ 2,
+  /*13*/ 3,
+  /*14*/ 3,
+  /*15*/ 4,
+  /*16*/ 1,
+  /*17*/ 2,
+  /*18*/ 2,
+  /*19*/ 3,
+  /*20*/ 2,
+  /*21*/ 3,
+  /*22*/ 3,
+  /*23*/ 4,
+  /*24*/ 2,
+  /*25*/ 3,
+  /*26*/ 3,
+  /*27*/ 4,
+  /*28*/ 3,
+  /*29*/ 4,
+  /*30*/ 4,
+  /*31*/ 5,
+  /*32*/ 1,
+  /*33*/ 2,
+  /*34*/ 2,
+  /*35*/ 3,
+  /*36*/ 2,
+  /*37*/ 3,
+  /*38*/ 3,
+  /*39*/ 4,
+  /*40*/ 2,
+  /*41*/ 3,
+  /*42*/ 3,
+  /*43*/ 4,
+  /*44*/ 3,
+  /*45*/ 4,
+  /*46*/ 4,
+  /*47*/ 5,
+  /*48*/ 2,
+  /*49*/ 3,
+  /*50*/ 3,
+  /*51*/ 4,
+  /*52*/ 3,
+  /*53*/ 4,
+  /*54*/ 4,
+  /*55*/ 5,
+  /*56*/ 3,
+  /*57*/ 4,
+  /*58*/ 4,
+  /*59*/ 5,
+  /*60*/ 4,
+  /*61*/ 5,
+  /*62*/ 5,
+  /*63*/ 6,
+  /*64*/ 1,
+  /*65*/ 2,
+  /*66*/ 2,
+  /*67*/ 3,
+  /*68*/ 2,
+  /*69*/ 3,
+  /*70*/ 3,
+  /*71*/ 4,
+  /*72*/ 2,
+  /*73*/ 3,
+  /*74*/ 3,
+  /*75*/ 4,
+  /*76*/ 3,
+  /*77*/ 4,
+  /*78*/ 4,
+  /*79*/ 5,
+  /*80*/ 2,
+  /*81*/ 3,
+  /*82*/ 3,
+  /*83*/ 4,
+  /*84*/ 3,
+  /*85*/ 4,
+  /*86*/ 4,
+  /*87*/ 5,
+  /*88*/ 3,
+  /*89*/ 4,
+  /*90*/ 4,
+  /*91*/ 5,
+  /*92*/ 4,
+  /*93*/ 5,
+  /*94*/ 5,
+  /*95*/ 6,
+  /*96*/ 2,
+  /*97*/ 3,
+  /*98*/ 3,
+  /*99*/ 4,
+  /*100*/ 3,
+  /*101*/ 4,
+  /*102*/ 4,
+  /*103*/ 5,
+  /*104*/ 3,
+  /*105*/ 4,
+  /*106*/ 4,
+  /*107*/ 5,
+  /*108*/ 4,
+  /*109*/ 5,
+  /*110*/ 5,
+  /*111*/ 6,
+  /*112*/ 3,
+  /*113*/ 4,
+  /*114*/ 4,
+  /*115*/ 5,
+  /*116*/ 4,
+  /*117*/ 5,
+  /*118*/ 5,
+  /*119*/ 6,
+  /*120*/ 4,
+  /*121*/ 5,
+  /*122*/ 5,
+  /*123*/ 6,
+  /*124*/ 5,
+  /*125*/ 6,
+  /*126*/ 6,
+  /*127*/ 7,
+  /*128*/ 1,
+  /*129*/ 2,
+  /*130*/ 2,
+  /*131*/ 3,
+  /*132*/ 2,
+  /*133*/ 3,
+  /*134*/ 3,
+  /*135*/ 4,
+  /*136*/ 2,
+  /*137*/ 3,
+  /*138*/ 3,
+  /*139*/ 4,
+  /*140*/ 3,
+  /*141*/ 4,
+  /*142*/ 4,
+  /*143*/ 5,
+  /*144*/ 2,
+  /*145*/ 3,
+  /*146*/ 3,
+  /*147*/ 4,
+  /*148*/ 3,
+  /*149*/ 4,
+  /*150*/ 4,
+  /*151*/ 5,
+  /*152*/ 3,
+  /*153*/ 4,
+  /*154*/ 4,
+  /*155*/ 5,
+  /*156*/ 4,
+  /*157*/ 5,
+  /*158*/ 5,
+  /*159*/ 6,
+  /*160*/ 2,
+  /*161*/ 3,
+  /*162*/ 3,
+  /*163*/ 4,
+  /*164*/ 3,
+  /*165*/ 4,
+  /*166*/ 4,
+  /*167*/ 5,
+  /*168*/ 3,
+  /*169*/ 4,
+  /*170*/ 4,
+  /*171*/ 5,
+  /*172*/ 4,
+  /*173*/ 5,
+  /*174*/ 5,
+  /*175*/ 6,
+  /*176*/ 3,
+  /*177*/ 4,
+  /*178*/ 4,
+  /*179*/ 5,
+  /*180*/ 4,
+  /*181*/ 5,
+  /*182*/ 5,
+  /*183*/ 6,
+  /*184*/ 4,
+  /*185*/ 5,
+  /*186*/ 5,
+  /*187*/ 6,
+  /*188*/ 5,
+  /*189*/ 6,
+  /*190*/ 6,
+  /*191*/ 7,
+  /*192*/ 2,
+  /*193*/ 3,
+  /*194*/ 3,
+  /*195*/ 4,
+  /*196*/ 3,
+  /*197*/ 4,
+  /*198*/ 4,
+  /*199*/ 5,
+  /*200*/ 3,
+  /*201*/ 4,
+  /*202*/ 4,
+  /*203*/ 5,
+  /*204*/ 4,
+  /*205*/ 5,
+  /*206*/ 5,
+  /*207*/ 6,
+  /*208*/ 3,
+  /*209*/ 4,
+  /*210*/ 4,
+  /*211*/ 5,
+  /*212*/ 4,
+  /*213*/ 5,
+  /*214*/ 5,
+  /*215*/ 6,
+  /*216*/ 4,
+  /*217*/ 5,
+  /*218*/ 5,
+  /*219*/ 6,
+  /*220*/ 5,
+  /*221*/ 6,
+  /*222*/ 6,
+  /*223*/ 7,
+  /*224*/ 3,
+  /*225*/ 4,
+  /*226*/ 4,
+  /*227*/ 5,
+  /*228*/ 4,
+  /*229*/ 5,
+  /*230*/ 5,
+  /*231*/ 6,
+  /*232*/ 4,
+  /*233*/ 5,
+  /*234*/ 5,
+  /*235*/ 6,
+  /*236*/ 5,
+  /*237*/ 6,
+  /*238*/ 6,
+  /*239*/ 7,
+  /*240*/ 4,
+  /*241*/ 5,
+  /*242*/ 5,
+  /*243*/ 6,
+  /*244*/ 5,
+  /*245*/ 6,
+  /*246*/ 6,
+  /*247*/ 7,
+  /*248*/ 5,
+  /*249*/ 6,
+  /*250*/ 6,
+  /*251*/ 7,
+  /*252*/ 6,
+  /*253*/ 7,
+  /*254*/ 7,
+  /*255*/ 8,
+};
+/* Table-driven popcount, with 8-bit tables */
+/* 6 ops plus 4 casts and 4 lookups, 0 long immediates, 4 stages */
+inline uint32_t
+popcount(uint32_t x)
+{
+    return popcount_table_8[(uint8_t)x] +
+       popcount_table_8[(uint8_t)(x >> 8)] +
+       popcount_table_8[(uint8_t)(x >> 16)] +
+       popcount_table_8[(uint8_t)(x >> 24)];
+}
+
+/* TODO: Add a 16-bit variant */
diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
new file mode 100644
--- /dev/null
+++ b/tests/HashMapProperties.hs
@@ -0,0 +1,220 @@
+ {-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
+
+-- | Tests for the 'Data.HashMap.Lazy' module.  We test functions by
+-- comparing them to a simpler model, an association list.
+
+module Main (main) where
+
+import qualified Data.Foldable as Foldable
+import Data.Function (on)
+import Data.Hashable (Hashable(hash))
+import qualified Data.List as L
+#if defined(STRICT)
+import qualified Data.HashMap.Strict as HM
+#else
+import qualified Data.HashMap.Lazy as HM
+#endif
+import qualified Data.Map as M
+import Test.QuickCheck (Arbitrary)
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+-- Key type that generates more hash collisions.
+newtype Key = K { unK :: Int }
+            deriving (Arbitrary, Eq, Ord, Show)
+
+instance Hashable Key where
+    hash k = hash (unK k) `mod` 20
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Instances
+
+pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pEq xs ys = (M.fromList xs ==) `eq` (HM.fromList xs ==) $ ys
+
+pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)
+
+pFunctor :: [(Key, Int)] -> Bool
+pFunctor = fmap (+ 1) `eq_` fmap (+ 1)
+
+pFoldable :: [(Int, Int)] -> Bool
+pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
+            (L.sort . Foldable.foldr (:) [])
+
+------------------------------------------------------------------------
+-- ** Basic interface
+
+pSize :: [(Key, Int)] -> Bool
+pSize = M.size `eq` HM.size
+
+pLookup :: Key -> [(Key, Int)] -> Bool
+pLookup k = M.lookup k `eq` HM.lookup k
+
+pInsert :: Key -> Int -> [(Key, Int)] -> Bool
+pInsert k v = M.insert k v `eq_` HM.insert k v
+
+pDelete :: Key -> [(Key, Int)] -> Bool
+pDelete k = M.delete k `eq_` HM.delete k
+
+pInsertWith :: Key -> [(Key, Int)] -> Bool
+pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1
+
+pAdjust :: Key -> [(Key, Int)] -> Bool
+pAdjust k = M.adjust succ k `eq_` HM.adjust succ k
+
+------------------------------------------------------------------------
+-- ** Combine
+
+pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pUnion xs ys = M.union (M.fromList xs) `eq_` HM.union (HM.fromList xs) $ ys
+
+pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_`
+                   HM.unionWith (-) (HM.fromList xs) $ ys
+
+------------------------------------------------------------------------
+-- ** Transformations
+
+pMap :: [(Key, Int)] -> Bool
+pMap = M.map (+1 ) `eq_` HM.map (+ 1)
+
+------------------------------------------------------------------------
+-- ** Difference and intersection
+
+pDifference :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pDifference xs ys = M.difference (M.fromList xs) `eq_`
+                    HM.difference (HM.fromList xs) $ ys
+
+pIntersection :: [(Key, Int)] -> [(Key, Int)] -> Bool
+pIntersection xs ys = M.intersection (M.fromList xs) `eq_`
+                      HM.intersection (HM.fromList xs) $ ys
+
+------------------------------------------------------------------------
+-- ** Folds
+
+pFoldr :: [(Int, Int)] -> Bool
+pFoldr = (L.sort . M.fold (:) []) `eq` (L.sort . HM.foldr (:) [])
+
+pFoldrWithKey :: [(Int, Int)] -> Bool
+pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq`
+                (sortByKey . HM.foldrWithKey f [])
+  where f k v z = (k, v) : z
+
+pFoldl' :: Int -> [(Int, Int)] -> Bool
+pFoldl' z0 = M.foldlWithKey' (\ z _ v -> v + z) z0 `eq` HM.foldl' (+) z0
+
+------------------------------------------------------------------------
+-- ** Filter
+
+pFilter :: [(Key, Int)] -> Bool
+pFilter = M.filter odd `eq_` HM.filter odd
+
+pFilterWithKey :: [(Key, Int)] -> Bool
+pFilterWithKey = M.filterWithKey p `eq_` HM.filterWithKey p
+  where p k v = odd (unK k + v)
+
+------------------------------------------------------------------------
+-- ** Conversions
+
+pToList :: [(Key, Int)] -> Bool
+pToList = M.toAscList `eq` toAscList
+
+pElems :: [(Key, Int)] -> Bool
+pElems = (L.sort . M.elems) `eq` (L.sort . HM.elems)
+
+pKeys :: [(Key, Int)] -> Bool
+pKeys = (L.sort . M.keys) `eq` (L.sort . HM.keys)
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Instances
+      testGroup "instances"
+      [ testProperty "==" pEq
+      , testProperty "/=" pNeq
+      , testProperty "Functor" pFunctor
+      , testProperty "Foldable" pFoldable
+      ]
+    -- Basic interface
+    , testGroup "basic interface"
+      [ testProperty "size" pSize
+      , testProperty "lookup" pLookup
+      , testProperty "insert" pInsert
+      , testProperty "delete" pDelete
+      , testProperty "insertWith" pInsertWith
+      , testProperty "adjust" pAdjust
+      ]
+    -- Combine
+    , testProperty "union" pUnion
+    , testProperty "unionWith" pUnionWith
+    -- Transformations
+    , testProperty "map" pMap
+    -- Folds
+    , testGroup "folds"
+      [ testProperty "foldr" pFoldr
+      , testProperty "foldrWithKey" pFoldrWithKey
+      , testProperty "foldl'" pFoldl'
+      ]
+    , testGroup "difference and intersection"
+      [ testProperty "difference" pDifference
+      , testProperty "intersection" pIntersection
+      ]
+    -- Filter
+    , testGroup "filter"
+      [ testProperty "filter" pFilter
+      , testProperty "filterWithKey" pFilterWithKey
+      ]
+    -- Conversions
+    , testGroup "conversions"
+      [ testProperty "elems" pElems
+      , testProperty "keys" pKeys
+      , testProperty "toList" pToList
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Model
+
+type Model k v = M.Map k v
+
+-- | Check that a function operating on a 'HashMap' is equivalent to
+-- one operating on a 'Model'.
+eq :: (Eq a, Eq k, Hashable k, Ord k)
+   => (Model k v -> a)       -- ^ Function that modifies a 'Model'
+   -> (HM.HashMap k v -> a)  -- ^ Function that modified a 'HashMap' in the same
+                             -- way
+   -> [(k, v)]               -- ^ Initial content of the 'HashMap' and 'Model'
+   -> Bool                   -- ^ True if the functions are equivalent
+eq f g xs = g (HM.fromList xs) == f (M.fromList xs)
+
+eq_ :: (Eq k, Eq v, Hashable k, Ord k)
+    => (Model k v -> Model k v)            -- ^ Function that modifies a 'Model'
+    -> (HM.HashMap k v -> HM.HashMap k v)  -- ^ Function that modified a
+                                           -- 'HashMap' in the same way
+    -> [(k, v)]                            -- ^ Initial content of the 'HashMap'
+                                           -- and 'Model'
+    -> Bool                                -- ^ True if the functions are
+                                           -- equivalent
+eq_ f g = (M.toAscList . f) `eq` (toAscList . g)
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Helpers
+
+sortByKey :: Ord k => [(k, v)] -> [(k, v)]
+sortByKey = L.sortBy (compare `on` fst)
+
+toAscList :: Ord k => HM.HashMap k v -> [(k, v)]
+toAscList = L.sortBy (compare `on` fst) . HM.toList
diff --git a/tests/HashSetProperties.hs b/tests/HashSetProperties.hs
new file mode 100644
--- /dev/null
+++ b/tests/HashSetProperties.hs
@@ -0,0 +1,171 @@
+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | Tests for the 'Data.HashSet' module.  We test functions by
+-- comparing them to a simpler model, a list.
+
+module Main (main) where
+
+import qualified Data.Foldable as Foldable
+import Data.Hashable (Hashable(hash))
+import qualified Data.List as L
+import qualified Data.HashSet as S
+import qualified Data.Set as Set
+import Test.QuickCheck (Arbitrary)
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+-- Key type that generates more hash collisions.
+newtype Key = K { unK :: Int }
+            deriving (Arbitrary, Eq, Ord, Show)
+
+instance Hashable Key where
+    hash k = hash (unK k) `mod` 20
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Instances
+
+pEq :: [Key] -> [Key] -> Bool
+pEq xs = (unique xs ==) `eq` (S.fromList xs ==)
+
+pNeq :: [Key] -> [Key] -> Bool
+pNeq xs = (unique xs /=) `eq` (S.fromList xs /=)
+
+pFoldable :: [Int] -> Bool
+pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
+            (L.sort . Foldable.foldr (:) [])
+
+------------------------------------------------------------------------
+-- ** Basic interface
+
+pSize :: [Key] -> Bool
+pSize = length `eq` S.size
+
+pMember :: Key -> [Key] -> Bool
+pMember k = L.elem k `eq` S.member k
+
+pInsert :: Key -> [Key] -> Bool
+pInsert a = insert a `eq` (toAscList . S.insert a)
+
+pDelete :: Key -> [Key] -> Bool
+pDelete a = delete a `eq` (toAscList . S.delete a)
+
+------------------------------------------------------------------------
+-- ** Combine
+
+pUnion :: [Key] -> [Key] -> Bool
+pUnion xs ys = L.sort (L.union as bs) ==
+               toAscList (S.union (S.fromList as) (S.fromList bs))
+  where
+    as = fromList xs
+    bs = fromList ys
+
+------------------------------------------------------------------------
+-- ** Transformations
+
+pMap :: [Key] -> Bool
+pMap = map f `eq` (toAscList . S.map f)
+  where f (K k) = K (k + 1)
+
+------------------------------------------------------------------------
+-- ** Folds
+
+pFoldr :: [Int] -> Bool
+pFoldr = (L.sort . L.foldr (:) []) `eq`
+         (L.sort . S.foldr (:) [])
+
+pFoldl' :: Int -> [Int] -> Bool
+pFoldl' z0 = L.foldl' (+) z0 `eq` S.foldl' (+) z0
+
+------------------------------------------------------------------------
+-- ** Conversions
+
+pToList :: [Key] -> Bool
+pToList = id `eq` toAscList
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Instances
+      testGroup "instances"
+      [ testProperty "==" pEq
+      , testProperty "/=" pNeq
+      , testProperty "Foldable" pFoldable
+      ]
+    -- Basic interface
+    , testGroup "basic interface"
+      [ testProperty "size" pSize
+      , testProperty "member" pMember
+      , testProperty "insert" pInsert
+      , testProperty "delete" pDelete
+      ]
+    -- Combine
+    , testProperty "union" pUnion
+    -- Transformations
+    , testProperty "map" pMap
+    -- Folds
+    , testGroup "folds"
+      [ testProperty "foldr" pFoldr
+      , testProperty "foldl'" pFoldl'
+      ]
+    -- Conversions
+    , testGroup "conversions"
+      [ testProperty "toList" pToList
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Model
+
+-- Invariant: the list is sorted in ascending order, by key.
+type Model a = [a]
+
+-- | Check that a function operating on a 'HashMap' is equivalent to
+-- one operating on a 'Model'.
+eq :: (Eq a, Hashable a, Ord a, Eq b)
+   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same
+                          -- way
+   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'
+   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'
+   -> Bool                -- ^ True if the functions are equivalent
+eq f g xs = g (S.fromList ys) == f ys
+  where ys = fromList xs
+
+insert :: Ord a => a -> Model a -> Model a
+insert x [] = [x]
+insert x (y:xs)
+    | x == y    = x : xs
+    | x > y     = y : insert x xs
+    | otherwise = x : y : xs
+
+delete :: Ord a => a -> Model a -> Model a
+delete _ [] = []
+delete k ys@(y:xs)
+    | k == y   = xs
+    | k > y    = y : delete k xs
+    | otherwise = ys
+
+-- | Create a model from a list of key-value pairs.  If the input
+-- contains multiple entries for the same key, the latter one is used.
+fromList :: Ord a => [a] -> Model a
+fromList = L.foldl' (\ m p -> insert p m) []
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Helpers
+
+toAscList :: Ord a => S.HashSet a -> [a]
+toAscList = L.sort . S.toList
+
+unique :: (Eq a, Ord a) => [a] -> [a]
+unique = Set.toList . Set.fromList
diff --git a/tests/MapProperties.hs b/tests/MapProperties.hs
deleted file mode 100644
--- a/tests/MapProperties.hs
+++ /dev/null
@@ -1,222 +0,0 @@
- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- | Tests for the 'Data.HashMap.Lazy' module.  We test functions by
--- comparing them to a simpler model, an association list.
-
-module Main (main) where
-
-import qualified Data.Foldable as Foldable
-import Data.Function (on)
-import Data.Hashable (Hashable(hash))
-import qualified Data.List as L
-import qualified Data.HashMap.Lazy as M
-import Test.QuickCheck (Arbitrary)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-
--- Key type that generates more hash collisions.
-newtype Key = K { unK :: Int }
-            deriving (Arbitrary, Eq, Ord, Show)
-
-instance Hashable Key where
-    hash k = hash (unK k) `mod` 20
-
-------------------------------------------------------------------------
--- * Properties
-
-------------------------------------------------------------------------
--- ** Instances
-
-pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
-pEq xs ys = (as ==) `eq` (M.fromList as ==) $ bs
-  where as = fromList xs
-        bs = fromList ys
-
-pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool
-pNeq xs = (xs /=) `eq` (M.fromList xs /=)
-
-pFunctor :: [(Key, Int)] -> Bool
-pFunctor = fmap (\ (k, v) -> (k, v + 1)) `eq` (toAscList . fmap (+ 1))
-
-pFoldable :: [(Int, Int)] -> Bool
-pFoldable = (L.sort . Foldable.foldr (\ (_, v) z -> v:z) []) `eq`
-            (L.sort . Foldable.foldr (:) [])
-
-------------------------------------------------------------------------
--- ** Basic interface
-
-pSize :: [(Key, Int)] -> Bool
-pSize = length `eq` M.size
-
-pLookup :: Key -> [(Key, Int)] -> Bool
-pLookup k = L.lookup k `eq` M.lookup k
-
-pInsert :: Key -> Int -> [(Key, Int)] -> Bool
-pInsert k v = insert (k, v) `eq` (toAscList . M.insert k v)
-
-pDelete :: Key -> [(Key, Int)] -> Bool
-pDelete k = delete k `eq` (toAscList . M.delete k)
-
-pInsertWith :: Key -> [(Key, Int)] -> Bool
-pInsertWith k = insertWith (+) (k, 1) `eq`
-                (toAscList . M.insertWith (+) k 1)
-
-------------------------------------------------------------------------
--- ** Combine
-
-pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool
-pUnion xs ys = L.sort (unionByKey as bs) == 
-               toAscList (M.union (M.fromList as) (M.fromList bs))
-  where
-    as = fromList xs
-    bs = fromList ys
-
-pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool
-pUnionWith xs ys = L.sort (unionByKeyWith (-) as bs) ==
-                   toAscList (M.unionWith (-) (M.fromList as) (M.fromList bs))
-  where
-    as = fromList xs
-    bs = fromList ys
-
-------------------------------------------------------------------------
--- ** Transformations
-
-pMap :: [(Key, Int)] -> Bool
-pMap = map (\ (k, v) -> (k, v + 1)) `eq` (toAscList . M.map (+ 1))
-
-------------------------------------------------------------------------
--- ** Folds
-
-pFoldr :: [(Int, Int)] -> Bool
-pFoldr = (L.sort . L.foldr (\ (_, v) z -> v:z) []) `eq`
-         (L.sort . M.foldr (:) [])
-
-pFoldrWithKey :: [(Int, Int)] -> Bool
-pFoldrWithKey = (sortByKey . L.foldr (:) []) `eq`
-                (sortByKey . M.foldrWithKey f [])
-  where f k v z = (k, v) : z
-
-pFoldl' :: Int -> [(Int, Int)] -> Bool
-pFoldl' z0 = L.foldl' (\ z (_, v) -> z + v) z0 `eq` M.foldl' (+) z0
-
-------------------------------------------------------------------------
--- ** Conversions
-
-pToList :: [(Key, Int)] -> Bool
-pToList = id `eq` toAscList
-
-pElems :: [(Key, Int)] -> Bool
-pElems = (L.sort . map snd) `eq` (L.sort . M.elems)
-
-pKeys :: [(Key, Int)] -> Bool
-pKeys = map fst `eq` (L.sort . M.keys)
-
-------------------------------------------------------------------------
--- * Test list
-
-tests :: [Test]
-tests =
-    [
-    -- Instances
-      testGroup "instances"
-      [ testProperty "==" pEq
-      , testProperty "/=" pNeq
-      , testProperty "Functor" pFunctor
-      , testProperty "Foldable" pFoldable
-      ]
-    -- Basic interface
-    , testGroup "basic interface"
-      [ testProperty "size" pSize
-      , testProperty "lookup" pLookup
-      , testProperty "insert" pInsert
-      , testProperty "delete" pDelete
-      , testProperty "insertWith" pInsertWith
-      ]
-    -- Combine
-    , testProperty "union" pUnion
-    , testProperty "unionWith" pUnionWith
-    -- Transformations
-    , testProperty "map" pMap
-    -- Folds
-    , testGroup "folds"
-      [ testProperty "foldr" pFoldr
-      , testProperty "foldrWithKey" pFoldrWithKey
-      , testProperty "foldl'" pFoldl'
-      ]
-    -- Conversions
-    , testGroup "conversions"
-      [ testProperty "elems" pElems
-      , testProperty "keys" pKeys
-      , testProperty "toList" pToList
-      ]
-    ]
-
-------------------------------------------------------------------------
--- * Model
-
--- Invariant: the list is sorted in ascending order, by key.
-type Model k v = [(k, v)]
-
--- | Check that a function operating on a 'HashMap' is equivalent to
--- one operating on a 'Model'.
-eq :: (Eq a, Eq k, Hashable k, Ord k)
-   => (Model k v -> a)      -- ^ Function that modifies a 'Model' in the same
-                            -- way
-   -> (M.HashMap k v -> a)  -- ^ Function that modified a 'HashMap'
-   -> [(k, v)]              -- ^ Initial content of the 'HashMap' and 'Model'
-   -> Bool                  -- ^ True if the functions are equivalent
-eq f g xs = g (M.fromList ys) == f ys
-  where ys = fromList xs
-
-insert :: Ord k => (k, v) -> Model k v -> Model k v
-insert x [] = [x]
-insert x@(k, _) (y@(k', _):xs)
-    | k == k'   = x : xs
-    | k > k'    = y : insert x xs
-    | otherwise = x : y : xs
-
-delete :: Ord k => k -> Model k v -> Model k v
-delete _ [] = []
-delete k ys@(y@(k', _):xs)
-    | k == k'   = xs
-    | k > k'    = y : delete k xs
-    | otherwise = ys
-
-insertWith :: Ord k => (v -> v -> v) -> (k, v) -> Model k v -> Model k v
-insertWith _ x [] = [x]
-insertWith f x@(k, v) (y@(k', v'):xs)
-    | k == k'   = (k', f v v') : xs
-    | k > k'    = y : insertWith f x xs
-    | otherwise = x : y : xs
-
--- | Create a model from a list of key-value pairs.  If the input
--- contains multiple entries for the same key, the latter one is used.
-fromList :: Ord k => [(k, v)] -> Model k v
-fromList = L.foldl' (\ m p -> insert p m) []
-
-------------------------------------------------------------------------
--- * Test harness
-
-main :: IO ()
-main = defaultMain tests
-
-------------------------------------------------------------------------
--- * Helpers
-
-sortByKey :: Ord k => [(k, v)] -> [(k, v)]
-sortByKey = L.sortBy (compare `on` fst)
-
-unionByKey :: (Eq k, Eq v) => [(k, v)] -> [(k, v)] -> [(k, v)]
-unionByKey = L.unionBy ((==) `on` fst)
-
-unionByKeyWith :: (Eq k, Eq v) => (v -> v -> v) -> [(k,v)] -> [(k,v)] -> [(k,v)]
-unionByKeyWith f a b = go a b
-  where
-   go [] ys = ys
-   go (x:xs) ys =
-     case L.lookup (fst x) ys of
-       Just z -> (fst x, f (snd x) z) : go xs (filter ((/= fst x) . fst) ys)
-       Nothing -> x : go xs ys
-
-toAscList :: (Ord k, Ord v) => M.HashMap k v -> [(k, v)]
-toAscList = L.sort . M.toList
diff --git a/tests/SetProperties.hs b/tests/SetProperties.hs
deleted file mode 100644
--- a/tests/SetProperties.hs
+++ /dev/null
@@ -1,171 +0,0 @@
- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- | Tests for the 'Data.HashSet' module.  We test functions by
--- comparing them to a simpler model, a list.
-
-module Main (main) where
-
-import qualified Data.Foldable as Foldable
-import Data.Hashable (Hashable(hash))
-import qualified Data.List as L
-import qualified Data.HashSet as S
-import qualified Data.Set as Set
-import Test.QuickCheck (Arbitrary)
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-
--- Key type that generates more hash collisions.
-newtype Key = K { unK :: Int }
-            deriving (Arbitrary, Eq, Ord, Show)
-
-instance Hashable Key where
-    hash k = hash (unK k) `mod` 20
-
-------------------------------------------------------------------------
--- * Properties
-
-------------------------------------------------------------------------
--- ** Instances
-
-pEq :: [Key] -> [Key] -> Bool
-pEq xs = (unique xs ==) `eq` (S.fromList xs ==)
-
-pNeq :: [Key] -> [Key] -> Bool
-pNeq xs = (unique xs /=) `eq` (S.fromList xs /=)
-
-pFoldable :: [Int] -> Bool
-pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
-            (L.sort . Foldable.foldr (:) [])
-
-------------------------------------------------------------------------
--- ** Basic interface
-
-pSize :: [Key] -> Bool
-pSize = length `eq` S.size
-
-pMember :: Key -> [Key] -> Bool
-pMember k = L.elem k `eq` S.member k
-
-pInsert :: Key -> [Key] -> Bool
-pInsert a = insert a `eq` (toAscList . S.insert a)
-
-pDelete :: Key -> [Key] -> Bool
-pDelete a = delete a `eq` (toAscList . S.delete a)
-
-------------------------------------------------------------------------
--- ** Combine
-
-pUnion :: [Key] -> [Key] -> Bool
-pUnion xs ys = L.sort (L.union as bs) ==
-               toAscList (S.union (S.fromList as) (S.fromList bs))
-  where
-    as = fromList xs
-    bs = fromList ys
-
-------------------------------------------------------------------------
--- ** Transformations
-
-pMap :: [Key] -> Bool
-pMap = map f `eq` (toAscList . S.map f)
-  where f (K k) = K (k + 1)
-
-------------------------------------------------------------------------
--- ** Folds
-
-pFoldr :: [Int] -> Bool
-pFoldr = (L.sort . L.foldr (:) []) `eq`
-         (L.sort . S.foldr (:) [])
-
-pFoldl' :: Int -> [Int] -> Bool
-pFoldl' z0 = L.foldl' (+) z0 `eq` S.foldl' (+) z0
-
-------------------------------------------------------------------------
--- ** Conversions
-
-pToList :: [Key] -> Bool
-pToList = id `eq` toAscList
-
-------------------------------------------------------------------------
--- * Test list
-
-tests :: [Test]
-tests =
-    [
-    -- Instances
-      testGroup "instances"
-      [ testProperty "==" pEq
-      , testProperty "/=" pNeq
-      , testProperty "Foldable" pFoldable
-      ]
-    -- Basic interface
-    , testGroup "basic interface"
-      [ testProperty "size" pSize
-      , testProperty "member" pMember
-      , testProperty "insert" pInsert
-      , testProperty "delete" pDelete
-      ]
-    -- Combine
-    , testProperty "union" pUnion
-    -- Transformations
-    , testProperty "map" pMap
-    -- Folds
-    , testGroup "folds"
-      [ testProperty "foldr" pFoldr
-      , testProperty "foldl'" pFoldl'
-      ]
-    -- Conversions
-    , testGroup "conversions"
-      [ testProperty "toList" pToList
-      ]
-    ]
-
-------------------------------------------------------------------------
--- * Model
-
--- Invariant: the list is sorted in ascending order, by key.
-type Model a = [a]
-
--- | Check that a function operating on a 'HashMap' is equivalent to
--- one operating on a 'Model'.
-eq :: (Eq a, Hashable a, Ord a, Eq b)
-   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same
-                          -- way
-   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'
-   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'
-   -> Bool                -- ^ True if the functions are equivalent
-eq f g xs = g (S.fromList ys) == f ys
-  where ys = fromList xs
-
-insert :: Ord a => a -> Model a -> Model a
-insert x [] = [x]
-insert x (y:xs)
-    | x == y    = x : xs
-    | x > y     = y : insert x xs
-    | otherwise = x : y : xs
-
-delete :: Ord a => a -> Model a -> Model a
-delete _ [] = []
-delete k ys@(y:xs)
-    | k == y   = xs
-    | k > y    = y : delete k xs
-    | otherwise = ys
-
--- | Create a model from a list of key-value pairs.  If the input
--- contains multiple entries for the same key, the latter one is used.
-fromList :: Ord a => [a] -> Model a
-fromList = L.foldl' (\ m p -> insert p m) []
-
-------------------------------------------------------------------------
--- * Test harness
-
-main :: IO ()
-main = defaultMain tests
-
-------------------------------------------------------------------------
--- * Helpers
-
-toAscList :: Ord a => S.HashSet a -> [a]
-toAscList = L.sort . S.toList
-
-unique :: (Eq a, Ord a) => [a] -> [a]
-unique = Set.toList . Set.fromList
diff --git a/unordered-containers.cabal b/unordered-containers.cabal
--- a/unordered-containers.cabal
+++ b/unordered-containers.cabal
@@ -1,5 +1,5 @@
 name:           unordered-containers
-version:        0.1.4.6
+version:        0.2.0.0
 synopsis:       Efficient hashing-based container types
 description:
   Efficient hashing-based container types.  The containers have been
@@ -10,79 +10,96 @@
   amortized, but remains valid even if structures are shared.
 license:        BSD3
 license-file:   LICENSE
-author:         Johan Tibell <johan.tibell@gmail.com>
+author:         Johan Tibell
 maintainer:     johan.tibell@gmail.com
 bug-reports:    https://github.com/tibbe/unordered-containers/issues
-copyright:      (c) Daan Leijen 2002
-                (c) Andriy Palamarchuk 2008
-                (c) 2010-2011 Johan Tibell
+copyright:      2010-2012 Johan Tibell
+                2010 Edward Z. Yang
 category:       Data
 build-type:     Simple
 cabal-version:  >=1.8
--- The test files shouldn't have to go here, but the source files for
--- the test-suite stanzas don't get picked up by `cabal sdist`.
-Extra-source-files:
-  tests/MapProperties.hs
-  tests/SetProperties.hs
-  benchmarks/Benchmarks.hs
-  benchmarks/Makefile
-  benchmarks/Util/*.hs
 
+flag debug
+  description:  Enable debug support
+  default:      False
+
 library
   exposed-modules:
     Data.HashMap.Lazy
     Data.HashMap.Strict
     Data.HashSet
+  other-modules:
+    Data.HashMap.Array
+    Data.HashMap.Base
+    Data.HashMap.PopCount
+    Data.HashMap.UnsafeShift
 
   build-depends:
     base >= 4 && < 4.6,
     deepseq >= 1.1 && < 1.4,
     hashable >= 1.0.1.1 && < 1.2
 
-  other-modules:
-    Data.FullList.Lazy
-    Data.FullList.Strict
-    Data.HashMap.Common
-    Data.HashMap.Lazy.Internal
-    Data.HashMap.Strict.Internal
+  if impl(ghc < 7.4)
+    c-sources: cbits/popc.c
 
   ghc-options: -Wall -O2
   if impl(ghc >= 6.8)
     ghc-options: -fwarn-tabs
   if impl(ghc > 6.10)
     ghc-options: -fregs-graph
+  if flag(debug)
+    cpp-options: -DASSERTS
 
-test-suite map-properties
+test-suite hashmap-lazy-properties
   hs-source-dirs: tests
-  main-is: MapProperties.hs
+  main-is: HashMapProperties.hs
   type: exitcode-stdio-1.0
 
   build-depends:
-    base >= 4,
-    hashable >= 1.0.1.1,
+    base,
+    containers >= 0.4.1 && < 0.5,
+    hashable >= 1.0.1.1 && < 1.2,
     QuickCheck >= 2.4.0.1,
-    test-framework >= 0.3.3,
-    test-framework-quickcheck2 >= 0.2.9,
+    test-framework >= 0.3.3 && < 0.6,
+    test-framework-quickcheck2 >= 0.2.9 && < 0.3,
     unordered-containers
 
   ghc-options: -Wall
+  cpp-options: -DASSERTS
 
+test-suite hashmap-strict-properties
+  hs-source-dirs: tests
+  main-is: HashMapProperties.hs
+  type: exitcode-stdio-1.0
 
-test-suite set-properties
+  build-depends:
+    base,
+    containers >= 0.4.1 && < 0.5,
+    hashable >= 1.0.1.1 && < 1.2,
+    QuickCheck >= 2.4.0.1,
+    test-framework >= 0.3.3 && < 0.6,
+    test-framework-quickcheck2 >= 0.2.9 && < 0.3,
+    unordered-containers
+
+  ghc-options: -Wall
+  cpp-options: -DASSERTS -DSTRICT
+
+test-suite hashset-properties
   hs-source-dirs: tests
-  main-is: SetProperties.hs
+  main-is: HashSetProperties.hs
   type: exitcode-stdio-1.0
 
   build-depends:
-    base >= 4,
-    containers,
-    hashable >= 1.0.1.1,
+    base,
+    containers >= 0.4.1 && < 0.5,
+    hashable >= 1.0.1.1 && < 1.2,
     QuickCheck >= 2.4.0.1,
-    test-framework >= 0.3.3,
-    test-framework-quickcheck2 >= 0.2.9,
+    test-framework >= 0.3.3 && < 0.6,
+    test-framework-quickcheck2 >= 0.2.9 && < 0.3,
     unordered-containers
 
   ghc-options: -Wall
+  cpp-options: -DASSERTS
 
 source-repository head
   type:     git