diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,15 @@
-# Changelog for primitive-containers
+# Changelog
+All notable changes to this project will be documented in this file.
 
-## Unreleased changes
+The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## [0.4.0] - 2018-??-??
+### Added
+- Non-empty unlifted sets. Currently, the API is similar to the API for Sets.
+  However, functions that would be partial are removed (intersection,
+  difference, fromList), and functions that would be constant are removed (null).
+  There is no `Monoid` instance and no `IsList` instance.
+- fromSet function for non-empty unlifted sets
+- toSet function for non-empty unlifted sets
+
diff --git a/benchmark-gauge/Main.hs b/benchmark-gauge/Main.hs
--- a/benchmark-gauge/Main.hs
+++ b/benchmark-gauge/Main.hs
@@ -11,6 +11,7 @@
 import qualified Data.Set.Unboxed as DSU
 import qualified Data.Set.Lifted as DSL
 import qualified Data.Map.Unboxed.Unboxed as DMUU
+import qualified Data.Map.Unboxed.Lifted as DMUL
 import qualified Data.Map.Lifted.Lifted as DMLL
 import qualified Data.Map.Strict as M
 import qualified Data.IntMap.Strict as IM
@@ -21,6 +22,7 @@
   [ bgroup "Map"
     [ bgroup "lookup" 
       [ bench "primitive-unboxed-unboxed" $ whnf lookupAllUnboxed bigUnboxedMap
+      , bench "primitive-unboxed-lifted" $ whnf lookupAllUnboxedLifted bigUnboxedLiftedMap
       , bench "containers-map" $ whnf lookupAllContainers bigContainersMap
       , bench "containers-intmap" $ whnf lookupAllIntContainers bigContainersIntMap
       ]
@@ -84,6 +86,9 @@
 bigUnboxedMap :: DMUU.Map Int Int
 bigUnboxedMap = E.fromList (map (\x -> (x `mod` (bigNumber * 2),x)) (take bigNumber (randoms (mkStdGen 75843))))
 
+bigUnboxedLiftedMap :: DMUL.Map Int Int
+bigUnboxedLiftedMap = E.fromList (map (\x -> (x `mod` (bigNumber * 2),x)) (take bigNumber (randoms (mkStdGen 75843))))
+
 bigLiftedMap :: DMLL.Map Int Int
 bigLiftedMap = E.fromList (map (\x -> (x `mod` (bigNumber * 2),x)) (take bigNumber (randoms (mkStdGen 75843))))
 
@@ -97,6 +102,12 @@
 lookupAllUnboxed m = go 0 0 where
   go !acc !n = if n < bigNumber
     then go (acc + fromMaybe 0 (DMUU.lookup n m)) (n + 1)
+    else acc
+
+lookupAllUnboxedLifted :: DMUL.Map Int Int -> Int
+lookupAllUnboxedLifted m = go 0 0 where
+  go !acc !n = if n < bigNumber
+    then go (acc + fromMaybe 0 (DMUL.lookup n m)) (n + 1)
     else acc
 
 lookupAllSetUnboxed :: DSU.Set Int -> Int
diff --git a/primitive-containers.cabal b/primitive-containers.cabal
--- a/primitive-containers.cabal
+++ b/primitive-containers.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.0
 name: primitive-containers
-version: 0.3.0
+version: 0.3.1
 synopsis: containers backed by arrays
 description:
   Containers backed by flat arrays. Updates require rebuilding the
@@ -10,26 +10,33 @@
 author: Andrew Martin
 maintainer: andrew.thaddeus@gmail.com
 copyright: 2018 Andrew Martin
+category: Data Structures
 license: BSD3
 license-file: LICENSE
 build-type: Simple
 
 extra-source-files:
-    ChangeLog.md
-    README.md
+  ChangeLog.md
+  README.md
 
 source-repository head
   type: git
   location: https://github.com/andrewthad/primitive-containers
 
+flag checked
+  description:
+    Check all array indexing. This makes most functions slower, but
+    it replaces segfaults with descriptive errors. This should
+    only be used for debugging.
+  default: False
+  manual: True
+
 library
   hs-source-dirs:
       src
   build-depends:
       base >=4.9 && <5
-    , primitive >= 0.6.4
     , primitive-sort >= 0.1 && < 0.2
-    , contiguous >= 0.3 && < 0.4
     , hashable >= 1.2.5
     , deepseq >= 1.4
       -- move these five out when we kick out dependent maps 
@@ -38,6 +45,14 @@
     , unordered-containers >= 0.2.8.0
     , vector >= 0.11 && < 0.13
     , text >= 1.2 && < 1.3
+  if flag(checked)
+    build-depends: 
+        contiguous-checked >= 0.3.2 && < 0.4
+      , primitive-checked >= 0.6.4.1
+  else
+    build-depends: 
+        contiguous >= 0.3.2 && < 0.4
+      , primitive >= 0.6.4
   exposed-modules:
     Data.Continuous.Set.Lifted
     Data.Diet.Map.Strict.Lifted.Lifted
@@ -47,6 +62,7 @@
     Data.Diet.Set.Unboxed
     Data.Diet.Unbounded.Set.Lifted
     Data.Map.Lifted.Lifted
+    Data.Map.Lifted.Unlifted
     Data.Map.Unboxed.Lifted
     Data.Map.Unboxed.Unboxed
     Data.Map.Unboxed.Unlifted
@@ -55,6 +71,8 @@
     Data.Set.Lifted
     Data.Set.Unboxed
     Data.Set.Unlifted
+    Data.Set.NonEmpty.Unlifted
+    Data.Map.Interval
     Data.Map.Subset.Strict.Lifted
     Data.Map.Subset.Strict.Unlifted
     Data.Map.Subset.Lazy.Lifted
@@ -64,6 +82,7 @@
     Data.Dependent.Map.Lifted.Lifted
     Data.Dependent.Map.Unlifted.Lifted
     Data.Dependent.Map.Unboxed.Lifted
+    Data.Map.Interval.DBTSLL
   other-modules:
     Data.Concatenation
     Data.Diet.Map.Strict.Internal
@@ -77,6 +96,7 @@
     Data.Set.Lifted.Internal
     Data.Set.Unboxed.Internal
     Data.Set.Unlifted.Internal
+    Data.Map.Interval.DBTS.Internal
   ghc-options: -O2 -Wall
   default-language: Haskell2010
 
@@ -87,13 +107,13 @@
   build-depends:
       base
     , HUnit
-    , QuickCheck
+    , QuickCheck < 2.12
     , aeson
     , containers >= 0.5.10
     , primitive
     , primitive-containers
     , quantification >= 0.4
-    , quickcheck-classes >= 0.4.12
+    , quickcheck-classes >= 0.5
     , tasty
     , tasty-hunit
     , tasty-quickcheck
diff --git a/src/Data/Concatenation.hs b/src/Data/Concatenation.hs
--- a/src/Data/Concatenation.hs
+++ b/src/Data/Concatenation.hs
@@ -3,10 +3,18 @@
 
 module Data.Concatenation
   ( concatSized
+  , concatSized1
   ) where
 
+import Data.List.NonEmpty (NonEmpty((:|)))
+
 import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
 
+-- | Concatenate all the values in the list in the order they
+-- are given. This function attempts to perform smaller concatenations
+-- together. This is good for data structures that do not take
+-- advantage of sharing.
 concatSized :: forall m.
      (m -> Int) -- size function 
   -> m
@@ -16,12 +24,31 @@
 concatSized size empty combine = go [] where
   go :: [m] -> [m] -> m
   go !stack [] = L.foldl' combine empty (L.reverse stack)
-  go !stack (x : xs) = if size x > 0
-    then go (pushStack x stack) xs
-    else go stack xs
+  go !stack (x : xs) = go (pushStack x stack) xs
   pushStack :: m -> [m] -> [m]
   pushStack x [] = [x]
   pushStack x (s : ss) = if size x >= size s
     then pushStack (combine s x) ss
     else x : s : ss
+
+-- | This function is likely to be used for things like intersection
+-- where the zero-sized element is not an identity but a zero.
+concatSized1 :: forall m.
+     (m -> Int) -- size function 
+  -> (m -> m -> m)
+  -> NonEmpty m
+  -> m
+concatSized1 size combine (p :| ps) = go (p :| []) ps where
+  go :: NonEmpty m -> [m] -> m
+  go !stack [] = safeFoldl1' combine (NE.reverse stack)
+  go !stack (x : xs) = go (pushStack x stack) xs
+  pushStack :: m -> NonEmpty m -> NonEmpty m
+  pushStack x (s :| ss) = if size x >= size s
+    then case ss of
+      [] -> combine s x :| []
+      r : rs -> pushStack (combine s x) (r :| rs)
+    else x :| (s : ss)
+
+safeFoldl1' :: (a -> a -> a) -> NonEmpty a -> a
+safeFoldl1' f (a :| as) = L.foldl' f a as
 
diff --git a/src/Data/Dependent/Map/Internal.hs b/src/Data/Dependent/Map/Internal.hs
--- a/src/Data/Dependent/Map/Internal.hs
+++ b/src/Data/Dependent/Map/Internal.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
 
 module Data.Dependent.Map.Internal
   ( Map(..)
@@ -51,6 +52,7 @@
 import Data.Kind (Type)
 import Data.Aeson (ToJSON,FromJSON)
 import Data.Text (Text)
+import qualified Data.List as L
 import qualified Data.Vector as V
 import qualified Data.Exists as EX
 import qualified Data.Aeson as AE
@@ -154,23 +156,43 @@
       Nothing -> Nothing
       Just v -> Just (unwrapValue (Proxy :: Proxy v) (Proxy :: Proxy a) v)
 
-appendWith :: forall karr varr k v.
-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, ToSing k)
-  => (forall a. Sing a -> v a -> v a -> v a)
+appendWith :: forall u karr varr (k :: u -> Type) (v :: u -> Type).
+     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, ToSing k)
+  => (forall (a :: u). Sing a -> v a -> v a -> v a)
   -> Map karr varr k v
   -> Map karr varr k v
   -> Map karr varr k v
-appendWith f (Map m1) (Map m2) = id
-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)
-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)
-  $ Map (M.appendKeyWith (\(C.Apply k) v1 v2 -> f (EX.toSing k) v1 v2) m1 m2)
+appendWith f xs ys = fromList (nubUnionWith f (toList xs) (toList ys))
+-- For some reason, this more natural implementation causes segfaults
+-- appendWith f (Map m1) (Map m2) = id
+--   $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)
+--   $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)
+--   $ Map (M.appendWithKey (\(C.Apply k) v1 v2 -> f (EX.toSing k) v1 v2) m1 m2)
 
+nubUnionWith :: forall u (k :: u -> Type) (v :: u -> Type). (EqForallPoly k, ToSing k)
+  => (forall (a :: u). Sing a -> v a -> v a -> v a)
+  -> [DependentPair k v]
+  -> [DependentPair k v]
+  -> [DependentPair k v]
+nubUnionWith f = go [] where
+  go acc [] ys = acc ++ ys
+  go acc (x@(DependentPair kx vx) : xs) ys = case findPair kx ys of
+    Nothing -> go (x : acc) xs ys
+    Just (ys',vy) -> go (DependentPair kx (f (EX.toSing kx) vx vy) : acc) xs ys'
+
+findPair :: EqForallPoly k => k a -> [DependentPair k v] -> Maybe ([DependentPair k v], v a)
+findPair k = go [] where
+  go _ [] = Nothing
+  go finger (x@(DependentPair kx vx) : xs) = case EX.eqForallPoly k kx of
+    EX.WitnessedEqualityUnequal -> go (x : finger) xs
+    EX.WitnessedEqualityEqual -> Just (L.reverse finger ++ xs, vx)
+
 append :: forall karr varr k v.
-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, SemigroupForeach v, ToSing k)
+     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, SemigroupForeach v, ToSing k)
   => Map karr varr k v
   -> Map karr varr k v
   -> Map karr varr k v
-append = appendWith EX.appendForeach
+append = appendWith (EX.appendForeach :: (forall a. Sing a -> v a -> v a -> v a))
 
 appendRightBiased :: forall karr varr k v.
      (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)
diff --git a/src/Data/Dependent/Map/Unboxed/Lifted.hs b/src/Data/Dependent/Map/Unboxed/Lifted.hs
--- a/src/Data/Dependent/Map/Unboxed/Lifted.hs
+++ b/src/Data/Dependent/Map/Unboxed/Lifted.hs
@@ -180,10 +180,10 @@
 instance (Universally k Prim, ApplyUniversally k Prim, ToSing k, FromJSONKeyExists k, FromJSONForeach v, OrdForallPoly k) => FromJSON (Map k v) where
   parseJSON v = fmap Map (I.parseJSON v)
 
-instance (Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Semigroup (Map k v) where
+instance (ApplyUniversally k Prim, Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Semigroup (Map k v) where
   Map x <> Map y = Map (I.append x y)
 
-instance (Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Monoid (Map k v) where
+instance (ApplyUniversally k Prim, Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Monoid (Map k v) where
   mempty = Map I.empty
   mappend = (SG.<>)
 
diff --git a/src/Data/Diet/Map/Strict/Internal.hs b/src/Data/Diet/Map/Strict/Internal.hs
--- a/src/Data/Diet/Map/Strict/Internal.hs
+++ b/src/Data/Diet/Map/Strict/Internal.hs
@@ -50,6 +50,7 @@
 empty :: (Contiguous karr, Contiguous varr) => Map karr varr k v
 empty = Map I.empty I.empty
 
+-- Note: this is only correct when the function is a bijection.
 map :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w) => (v -> w) -> Map karr varr k v -> Map karr varr k w
 map f (Map k v) = Map k (I.map f v)
 
diff --git a/src/Data/Diet/Map/Strict/Unboxed/Lifted.hs b/src/Data/Diet/Map/Strict/Unboxed/Lifted.hs
--- a/src/Data/Diet/Map/Strict/Unboxed/Lifted.hs
+++ b/src/Data/Diet/Map/Strict/Unboxed/Lifted.hs
@@ -9,7 +9,7 @@
   , empty
   , singleton
   , lookup
-  , mapEqualityMorphism
+  , mapBijection
   , fromSet
     -- * List Conversion
   , fromList
@@ -86,18 +86,18 @@
   -> Map k v
 fromListAppendN n = Map . I.fromListAppendN n
 
--- | Map an equality morphism over the values in a diet map. An equality
--- morphism @f@ must satisfy the law:
+-- | Map an equality morphism over the values in a diet map. An bijection
+-- @f@ must satisfy the law:
 --
 -- > ∀ x y. x == y ↔ f x == f y
 --
 -- Since this does not actually use the 'Eq' constraint on the new value
 -- type, it is lazy in the values.
-mapEqualityMorphism :: (Prim k, Ord k)
-  => (v -> w) -- ^ equality morphism
+mapBijection :: (Prim k, Ord k)
+  => (v -> w) -- ^ bijection
   -> Map k v
   -> Map k w
-mapEqualityMorphism f (Map m) = Map (I.map f m)
+mapBijection f (Map m) = Map (I.map f m)
 
 -- | Convert a diet set to a diet map, constructing each value
 -- from the low and high key in its corresponding range.
diff --git a/src/Data/Map/Internal.hs b/src/Data/Map/Internal.hs
--- a/src/Data/Map/Internal.hs
+++ b/src/Data/Map/Internal.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RankNTypes #-}
@@ -15,6 +16,7 @@
   , map
   , mapWithKey
   , mapMaybe
+  , mapMaybeP
   , mapMaybeWithKey
     -- * Folds
   , foldrWithKey
@@ -28,13 +30,17 @@
   , foldlMapWithKeyM'
   , foldrMapWithKeyM'
     -- * Traversals
+  , traverse
   , traverseWithKey_
     -- * Functions
   , append
   , appendWith
-  , appendKeyWith
+  , appendWithKey
   , appendRightBiased
   , intersectionWith
+  , intersectionsWith
+  , adjustMany
+  , adjustManyInline
   , lookup
   , showsPrec
   , equals
@@ -42,6 +48,7 @@
   , toList
   , concat
   , size
+  , sizeKeys
   , keys
   , elems
   , restrict
@@ -52,25 +59,29 @@
   , fromListAppend
   , fromListAppendN
   , fromSet
+  , fromSetP
     -- * Array Conversion
   , unsafeFreezeZip
   , unsafeZipPresorted
   ) where
 
-import Prelude hiding (compare,showsPrec,lookup,map,concat,null)
+import Prelude hiding (compare,showsPrec,lookup,map,concat,null,traverse)
 
 import Control.Applicative (liftA2)
 import Control.DeepSeq (NFData)
+import Control.Monad.Primitive (PrimMonad,PrimState)
 import Control.Monad.ST (ST,runST)
-import Data.Semigroup (Semigroup)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Primitive.Contiguous (Contiguous,Mutable,Element)
 import Data.Primitive.Sort (sortUniqueTaggedMutable)
+import Data.Semigroup (Semigroup)
 import Data.Set.Internal (Set(..))
+
+import qualified Data.Concatenation as C
 import qualified Data.List as L
+import qualified Data.Primitive.Contiguous as I
 import qualified Data.Semigroup as SG
 import qualified Prelude as P
-import qualified Data.Primitive.Contiguous as I
-import qualified Data.Concatenation as C
 
 -- TODO: Do some sneakiness with UnliftedRep
 data Map karr varr k v = Map !(karr k) !(varr v)
@@ -206,7 +217,7 @@
 map :: (Contiguous varr, Element varr v, Element varr w) => (v -> w) -> Map karr varr k v -> Map karr varr k w
 map f (Map k v) = Map k (I.map f v)
 
--- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
+-- | /O(n)/ Map over the elements with access to their corresponding keys.
 mapWithKey :: forall karr varr k v w. (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)
   => (k -> v -> w)
   -> Map karr varr k v
@@ -234,7 +245,7 @@
   => (v -> Maybe w)
   -> Map karr varr k v
   -> Map karr varr k w
-{-# INLINEABLE mapMaybe #-}
+{-# INLINE mapMaybe #-}
 mapMaybe f (Map ks vs) = runST $ do
   let !sz = I.size vs
   !(karr :: Mutable karr s k) <- I.new sz
@@ -255,6 +266,31 @@
   return (Map ksFinal vsFinal)
 
 -- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
+mapMaybeP :: forall karr varr m k v w. (PrimMonad m, Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)
+  => (v -> m (Maybe w))
+  -> Map karr varr k v
+  -> m (Map karr varr k w)
+{-# INLINE mapMaybeP #-}
+mapMaybeP f (Map ks vs) = do
+  let !sz = I.size vs
+  !(karr :: Mutable karr (PrimState m) k) <- I.new sz
+  !(varr :: Mutable varr (PrimState m) w) <- I.new sz
+  let go !ixSrc !ixDst = if ixSrc < sz
+        then do
+          a <- I.indexM vs ixSrc
+          f a >>= \case
+            Nothing -> go (ixSrc + 1) ixDst
+            Just b -> do
+              I.write varr ixDst b
+              I.write karr ixDst =<< I.indexM ks ixSrc
+              go (ixSrc + 1) (ixDst + 1)
+        else return ixDst
+  dstLen <- go 0 0
+  ksFinal <- I.resize karr dstLen >>= I.unsafeFreeze
+  vsFinal <- I.resize varr dstLen >>= I.unsafeFreeze
+  return (Map ksFinal vsFinal)
+
+-- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
 mapMaybeWithKey :: forall karr varr k v w. (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)
   => (k -> v -> Maybe w)
   -> Map karr varr k v
@@ -316,6 +352,58 @@
              in mappend (f k v) (go (i + 1))
    in go 0
 
+adjustMany :: forall karr varr m k v a. (Contiguous karr, Element karr k, Contiguous varr, Element varr v, PrimMonad m, Ord k)
+  => ((k -> (v -> m v) -> m ()) -> m a) -- Callback that takes a modify function
+  -> Map karr varr k v
+  -> m (Map karr varr k v, a)
+{-# INLINABLE adjustMany #-}
+adjustMany f (Map theKeys theVals) = do
+  mvals <- I.thaw theVals 0 (I.size theVals)
+  let g :: k -> (v -> m v) -> m ()
+      g !k updateVal = 
+        let go !start !end = if end < start
+              then pure ()
+              else
+                let !mid = div (end + start) 2
+                    !(# v #) = I.index# theKeys mid
+                 in case P.compare k v of
+                      LT -> go start (mid - 1)
+                      EQ -> do
+                        r <- I.read mvals mid
+                        r' <- updateVal r
+                        I.write mvals mid r'
+                      GT -> go (mid + 1) end
+         in go 0 (I.size theVals - 1)
+  r <- f g
+  rvals <- I.unsafeFreeze mvals
+  pure (Map theKeys rvals, r)
+
+adjustManyInline :: forall karr varr m k v a. (Contiguous karr, Element karr k, Contiguous varr, Element varr v, PrimMonad m, Ord k)
+  => ((k -> (v -> m v) -> m ()) -> m a) -- Callback that takes a modify function
+  -> Map karr varr k v
+  -> m (Map karr varr k v, a)
+{-# INLINE adjustManyInline #-}
+adjustManyInline f (Map theKeys theVals) = do
+  mvals <- I.thaw theVals 0 (I.size theVals)
+  let g :: k -> (v -> m v) -> m ()
+      g !k updateVal = 
+        let go !start !end = if end < start
+              then pure ()
+              else
+                let !mid = div (end + start) 2
+                    !(# v #) = I.index# theKeys mid
+                 in case P.compare k v of
+                      LT -> go start (mid - 1)
+                      EQ -> do
+                        r <- I.read mvals mid
+                        r' <- updateVal r
+                        I.write mvals mid r'
+                      GT -> go (mid + 1) end
+         in go 0 (I.size theVals - 1)
+  r <- f g
+  rvals <- I.unsafeFreeze mvals
+  pure (Map theKeys rvals, r)
+
 concat :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v, Semigroup v) => [Map karr varr k v] -> Map karr varr k v
 concat = concatWith (SG.<>)
 
@@ -325,12 +413,18 @@
   -> Map karr varr k v
 concatWith combine = C.concatSized size empty (appendWith combine)
 
+intersectionsWith :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Ord k)
+  => (v -> v -> v)
+  -> NonEmpty (Map karr varr k v)
+  -> Map karr varr k v
+intersectionsWith f = C.concatSized1 size (intersectionWith f)
+
 appendRightBiased :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Ord k) => Map karr varr k v -> Map karr varr k v -> Map karr varr k v
 appendRightBiased = appendWith const
 
-appendKeyWith :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Ord k)
+appendWithKey :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Ord k)
   => (k -> v -> v -> v) -> Map karr varr k v -> Map karr varr k v -> Map karr varr k v
-appendKeyWith combine (Map ksA vsA) (Map ksB vsB) =
+appendWithKey combine (Map ksA vsA) (Map ksB vsB) =
   case unionArrWith combine ksA vsA ksB vsB of
     (k,v) -> Map k v
   
@@ -437,6 +531,7 @@
   => k
   -> Map karr varr k v
   -> Maybe v
+{-# INLINEABLE lookup #-}
 lookup a (Map arr vals) = go 0 (I.size vals - 1) where
   go :: Int -> Int -> Maybe v
   go !start !end = if end < start
@@ -449,11 +544,14 @@
             EQ -> case I.index# vals mid of
               (# r #) -> Just r
             GT -> go (mid + 1) end
-{-# INLINEABLE lookup #-}
 
 size :: (Contiguous varr, Element varr v) => Map karr varr k v -> Int
 size (Map _ arr) = I.size arr
 
+-- This may have less constraints than size
+sizeKeys :: (Contiguous karr, Element karr k) => Map karr varr k v -> Int
+sizeKeys (Map arr _) = I.size arr
+
 -- | Sort and deduplicate the key array, preserving the last value associated
 -- with each key. The argument arrays may not be reused after being passed
 -- to this function. This function is only unsafe because of the requirement
@@ -534,6 +632,14 @@
     else return accl
 {-# INLINEABLE foldlMapWithKeyM' #-}
 
+traverse :: (Applicative m, Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)
+  => (v -> m w)
+  -> Map karr varr k v
+  -> m (Map karr varr k w)
+{-# INLINEABLE traverse #-}
+traverse f (Map theKeys theVals) =
+  fmap (Map theKeys) (I.traverse f theVals)
+
 traverseWithKey_ :: forall karr varr k v m b. (Applicative m, Contiguous karr, Element karr k, Contiguous varr, Element varr v)
   => (k -> v -> m b)
   -> Map karr varr k v
@@ -678,6 +784,14 @@
   -> Set karr k
   -> Map karr varr k v
 fromSet f (Set arr) = Map arr (I.map f arr)
+{-# INLINE fromSet #-}
+
+fromSetP :: (PrimMonad m, Contiguous karr, Element karr k, Contiguous varr, Element varr v)
+  => (k -> m v)
+  -> Set karr k
+  -> m (Map karr varr k v)
+fromSetP f (Set arr) = fmap (Map arr) (I.traverseP f arr)
+{-# INLINE fromSetP #-}
 
 keys :: Map karr varr k v -> Set karr k
 keys (Map k _) = Set k
diff --git a/src/Data/Map/Interval.hs b/src/Data/Map/Interval.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Interval.hs
@@ -0,0 +1,64 @@
+{-| 
+
+This module only exists for documentation. It should never be imported.
+
+The interval maps provided by the submodules of `Data.Map.Interval`
+coallesce overlapping intervals. Their behavior differs from that
+of the type from the `IntervalMap` package. The interval map from
+that package preserves all the original interval that were used
+as keys for the map. The interval map from this package creates a
+new interval from the overlap, combining the values.
+
+There are several points in the design space to explore with this
+kind of interval map. A motivation for some of these variants is
+having `Eq` instances that satisfy a bidirectional variant of the
+substition law. That is:
+
+> ∀ x y. (x == y ↔ ∀ f. f x == f y)
+
+Here are the different design choices that we face:
+
+* Discrete (D) vs Continuous (C): The basically comes down to whether or
+  not there is an `Enum` instance for the type. Although it cannot be
+  enforced by the type system, continuous-keyed maps should not use discrete
+  types as keys. The bidirectional substituion law is not upheld in this
+  case. The discrete-keyed interval map uses `succ` and `pred`
+  to coalesce adjacent intervals. The continuous-keyed interval map,
+  assuming that unequal values have infinitely many values between
+  them, only considers merging adjacent intervals when an open interval
+  butts up against a closed interval with a matching key.
+* Bounded (B) vs Unbounded (U): Is there a Bounded instance for the type?
+  Bounded types can treat `maxBound` as infinity. Unbounded types like
+  `Integer` and `Text` have no value for infinity. If the key type has
+  a `Bounded` instance, it is incorrect to use it in an unbounded interval
+  map since the `Eq` instance will not satisfy the bidirectional substitution law.
+* Partial (P) vs Total (T): Is there a value corresponding to every key?
+  The decides whether or not the return value of `lookup` is wrapped in a
+  `Maybe`. Total maps with unconstrained values also have an `Applicative`
+  instance. The internal representation of total maps is also more
+  efficient than that of partial maps since we only need to store the
+  upper bound of each interval.
+* Coalesce (S) vs Detach (H): The names here a little here are a little
+  misleading. The strict variant uses on an `Eq` instance for values
+  to coallesce adjacent ranges. For example, with discrete integers,
+  the interval-value pairs ([4,6],12) and ([7,9],12) can be coallesced
+  because 6 is adjacent to 7 and both pairs share value 12. Coalescing
+  in this way is crucial to satisfying the bidirectional substitution
+  law. It also induces value-strictness. Some users may prefer
+  laziness in the values. This is also offered, but none of the
+  value-lazy interval maps have `Eq` instances since it is not possible
+  to satisfy the bidirectional substitution law without forcing the
+  values.
+
+The modules are named using acronyms that refer to various combinations
+of these flavors. For exmaple, `Data.Map.Interval.DUTS` provides the
+discrete unbounded total strict interval map. Some combinations are not
+provided because the author is unaware of useful types that meet the
+restrictions (for example, pairing continuous and bounded seems
+dubious).
+
+For users who want to use 'Double' as the key type, it is recommended
+that CUxx be used since the `Enum` instance for `Double` is dubious.
+
+-}
+module Data.Map.Interval () where
diff --git a/src/Data/Map/Interval/DBTS/Internal.hs b/src/Data/Map/Interval/DBTS/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Interval/DBTS/Internal.hs
@@ -0,0 +1,383 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Data.Map.Interval.DBTS.Internal
+  ( Map
+  , pure
+  , singleton
+  , empty
+  , lookup
+  , union
+  , unionWith
+  , equals
+  , map
+  , mapBijection
+  , traverseP
+  , traverse
+  , traverse_
+  , fromList
+  , foldrWithKey
+  , foldlWithKeyM'
+  , foldl'
+  , foldMap
+  , toList
+  , showsPrec
+  , concat
+  , elems
+  ) where
+
+import Prelude hiding (pure,lookup,compare,map,showsPrec,concat,traverse,foldMap)
+
+import Control.Monad.ST (ST,runST)
+import Control.Monad.Primitive (PrimMonad)
+import Data.Primitive (PrimArray)
+import Data.Primitive.Contiguous (Contiguous,Element,Mutable)
+import qualified Data.Concatenation as C
+import qualified Data.Primitive.Contiguous as I
+import qualified Prelude as P
+
+-- | The key array is the same length as the value array. Every key
+--   is the upper bound of a range. The keys array always has a length
+--   of at least one. The last element is always maxBound. The lowest bound
+--   is assumed to be minBound. For example, the interval map of @Int16@:
+--
+--   > [-inf,5],[6,17],[18,20],[21,+inf]
+--
+--   Would be represented by the keys:
+--   
+--   > 5,17,20,65536
+data Map karr varr k v = Map !(karr k) !(varr v)
+
+equals :: (Contiguous karr, Element karr k, Eq k, Contiguous varr, Element varr v, Eq v) => Map karr varr k v -> Map karr varr k v -> Bool
+equals (Map k1 v1) (Map k2 v2) = I.equals k1 k2 && I.equals v1 v2
+
+size :: (Contiguous varr, Element varr v)
+  => Map karr varr k v
+  -> Int
+size (Map _ v) = I.size v
+
+-- compare :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v, Ord v) => Map karr varr k v -> Map karr varr k v -> Bool
+-- compare (Map k1 v1) (Map k2 v2) = mappend (I.compare k1 k2) (I.compare v1 v2)
+
+-- Note: this is only correct when the function is a bijection.
+mapBijection :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)
+  => (v -> w) -> Map karr varr k v -> Map karr varr k w
+mapBijection f (Map k v) = Map k (I.map f v)
+
+-- The function does not need to be a bijection. It may cause adjacent
+-- keys to collapse if their values become the same.
+map :: forall karr varr k v w. (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w, Eq w)
+  => (v -> w)
+  -> Map karr varr k v
+  -> Map karr varr k w
+map f (Map keys vals) = runST action where
+  !sz = I.size vals
+  action :: forall s. ST s (Map karr varr k w)
+  action = do
+    m <- I.new sz
+    let go :: Int -> Int -> w -> [Int] -> Int -> ST s (Int,[Int],Int)
+        go !ixSrc !ixDst !prevVal !dropped !droppedCount = if ixSrc < sz
+          then do
+            oldVal <- I.indexM vals ixSrc
+            let val = f oldVal
+            if val == prevVal
+              then go (ixSrc + 1) ixDst val ((ixSrc - 1) : dropped) (droppedCount + 1)
+              else do
+                I.write m ixDst val
+                go (ixSrc + 1) (ixDst + 1) val dropped droppedCount
+          else return (ixDst,dropped,droppedCount)
+    v0 <- I.indexM vals 0
+    let !w0 = f v0
+    I.write m 0 w0
+    (len,dropped,droppedCount) <- go 1 1 w0 [] 0
+    vals' <- I.resize m len >>= I.unsafeFreeze
+    case droppedCount of
+      0 -> return (Map keys vals')
+      _ -> do
+        n <- I.new len
+        let !(d :: PrimArray Int) = I.unsafeFromListReverseN (droppedCount + 1) (maxBound : dropped)
+        let run :: Int -> Int -> Int -> ST s ()
+            run !ixKey !ixDst !ixDrop = if ixKey < sz
+              then if I.index d ixDrop == ixKey
+                then run (ixKey + 1) ixDst (ixDrop + 1)
+                else do
+                  I.write n ixDst =<< I.indexM keys ixKey
+                  run (ixKey + 1) (ixDst + 1) ixDrop
+              else return ()
+        run 0 0 0
+        keys' <- I.unsafeFreeze n
+        return (Map keys' vals')
+        
+
+-- Note: this is only correct when the function is a bijection.
+traverseP :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w, PrimMonad m)
+  => (v -> m w) -> Map karr varr k v -> m (Map karr varr k w)
+traverseP f (Map k v) = fmap (Map k) (I.traverseP f v)
+
+-- Note: this is only correct when the function is a bijection.
+traverse :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w, Applicative m)
+  => (v -> m w) -> Map karr varr k v -> m (Map karr varr k w)
+traverse f (Map k v) = fmap (Map k) (I.traverse f v)
+
+traverse_ :: (Contiguous varr, Element varr v, Element varr w, Applicative m)
+  => (v -> m w) -> Map karr varr k v -> m ()
+traverse_ f (Map _ v) = I.traverse_ f v
+
+pure :: (Contiguous karr, Contiguous varr, Element karr k, Element varr v, Bounded k) => v -> Map karr varr k v
+pure v = Map
+  (runST $ do
+     !(arr :: Mutable karr s k) <- I.replicateM 1 maxBound
+     I.unsafeFreeze arr
+  )
+  (runST $ do
+     !(arr :: Mutable varr s v) <- I.replicateM 1 v
+     I.unsafeFreeze arr
+  )
+
+-- This is not actually empty, but it is the monoidal identity.
+empty :: (Contiguous karr, Contiguous varr, Element karr k, Element varr v, Bounded k, Monoid v) => Map karr varr k v
+empty = pure mempty
+
+singleton :: forall karr varr k v. (Contiguous karr, Contiguous varr, Element karr k, Element varr v, Bounded k, Enum k, Ord k, Eq v)
+  => v -- value outside of the interval
+  -> k -- lower bound
+  -> k -- upper bound
+  -> v -- value inside the interval
+  -> Map karr varr k v
+singleton def lo hi v = if lo <= hi && def /= v
+  then if lo > minBound
+    then if hi < maxBound
+      then Map
+        (runST $ do
+           !(arr :: Mutable karr s k) <- I.new 3
+           I.write arr 0 (pred lo)
+           I.write arr 1 hi
+           I.write arr 2 maxBound
+           I.unsafeFreeze arr
+        )
+        (runST $ do
+           !(arr :: Mutable varr s v) <- I.new 3
+           I.write arr 0 def
+           I.write arr 1 v
+           I.write arr 2 def
+           I.unsafeFreeze arr
+        )
+      else Map
+        (runST $ do
+           !(arr :: Mutable karr s k) <- I.new 2
+           I.write arr 0 (pred lo)
+           I.write arr 1 maxBound
+           I.unsafeFreeze arr
+        )
+        (runST $ do
+           !(arr :: Mutable varr s v) <- I.new 2
+           I.write arr 0 def
+           I.write arr 1 v
+           I.unsafeFreeze arr
+        )
+    else if hi < maxBound
+      then Map
+        (runST $ do
+           !(arr :: Mutable karr s k) <- I.new 2
+           I.write arr 0 hi
+           I.write arr 1 maxBound
+           I.unsafeFreeze arr
+        )
+        (runST $ do
+           !(arr :: Mutable varr s v) <- I.new 2
+           I.write arr 0 v
+           I.write arr 1 def
+           I.unsafeFreeze arr
+        )
+      else pure v
+  else pure def
+
+lookup :: forall karr varr k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v) => k -> Map karr varr k v -> v
+lookup a (Map keys vals) = go 0 (I.size vals - 1) where
+  go :: Int -> Int -> v
+  go !start !end = if end == start
+    then
+      let !(# v #) = I.index# vals start
+       in v
+    else
+      let !mid = div (end + start) 2
+          !valHi = I.index keys mid
+       in case P.compare a valHi of
+            LT -> go start mid
+            EQ -> case I.index# vals mid of
+              (# v #) -> v
+            GT -> go (mid + 1) end
+{-# INLINEABLE lookup #-}
+
+union :: forall karr varr k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v, Eq v, Semigroup v)
+  => Map karr varr k v
+  -> Map karr varr k v
+  -> Map karr varr k v
+union = unionWith (<>)
+
+-- This is also known as liftA2
+unionWith :: forall karr aarr barr carr k a b c. (Contiguous karr, Element karr k, Ord k, Contiguous aarr, Element aarr a, Contiguous barr, Element barr b, Contiguous carr, Element carr c, Eq c)
+  => (a -> b -> c)
+  -> Map karr aarr k a
+  -> Map karr barr k b
+  -> Map karr carr k c
+unionWith combine (Map keysA valsA) (Map keysB valsB) = runST action where
+  action :: forall s. ST s (Map karr carr k c)
+  action = do
+    let szA = I.size keysA
+        szB = I.size keysB
+        szMax = szA + szB
+    keysDst <- I.new szMax
+    valsDst <- I.new szMax
+    -- For total maps, we don't have to worry about one map running out
+    -- before the other. Also, this function has a precondition that
+    -- all three indices are greater than zero.
+    let go :: Int -> Int -> Int -> c -> ST s Int
+        go !ixA !ixB !ixDst prevVal = if ixA < szA && ixB < szB
+          then do
+            keyA <- I.indexM keysA ixA
+            keyB <- I.indexM keysB ixB
+            case P.compare keyA keyB of
+              EQ -> do
+                valA <- I.indexM valsA ixA
+                valB <- I.indexM valsB ixB
+                let !v = combine valA valB
+                if v == prevVal
+                  then do
+                    I.write keysDst (ixDst - 1) keyA
+                    go (ixA + 1) (ixB + 1) ixDst v
+                  else do
+                    I.write keysDst ixDst keyA
+                    I.write valsDst ixDst v
+                    go (ixA + 1) (ixB + 1) (ixDst + 1) v
+              LT -> do
+                valA <- I.indexM valsA ixA
+                valB <- I.indexM valsB ixB
+                let !v = combine valA valB
+                if v == prevVal
+                  then do
+                    I.write keysDst (ixDst - 1) keyA
+                    go (ixA + 1) ixB ixDst v
+                  else do
+                    I.write keysDst ixDst keyA
+                    I.write valsDst ixDst v
+                    go (ixA + 1) ixB (ixDst + 1) v
+              GT -> do
+                valA <- I.indexM valsA ixA
+                valB <- I.indexM valsB ixB
+                let !v = combine valA valB
+                if v == prevVal
+                  then do
+                    I.write keysDst (ixDst - 1) keyB
+                    go ixA (ixB + 1) ixDst v
+                  else do
+                    I.write keysDst ixDst keyB
+                    I.write valsDst ixDst v
+                    go ixA (ixB + 1) (ixDst + 1) v
+          else return ixDst
+    keyA <- I.indexM keysA 0
+    keyB <- I.indexM keysB 0
+    valA <- I.indexM valsA 0
+    valB <- I.indexM valsB 0
+    let v = combine valA valB
+    dstIx <- case P.compare keyA keyB of
+      EQ -> do
+        I.write keysDst 0 keyA
+        I.write valsDst 0 v
+        go 1 1 1 v
+      LT -> do
+        I.write keysDst 0 keyA
+        I.write valsDst 0 v
+        go 1 0 1 v
+      GT -> do
+        I.write keysDst 0 keyB
+        I.write valsDst 0 v
+        go 0 1 1 v
+    keys <- I.resize keysDst dstIx >>= I.unsafeFreeze
+    vals <- I.resize valsDst dstIx >>= I.unsafeFreeze
+    return (Map keys vals)
+
+showsPrec :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Bounded k, Enum k, Show k, Show v)
+  => Int -> Map karr varr k v -> ShowS
+showsPrec p m = showParen (p > 10)
+  $ showString "fromList "
+  . shows (toList m)
+
+foldrWithKey :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Bounded k, Enum k)
+  => (k -> k -> v -> b -> b)
+  -> b
+  -> Map karr varr k v
+  -> b
+foldrWithKey f z (Map keys vals) =
+  let !sz = I.size vals
+      -- we must be lazy in the second argument
+      go !i lo
+        | i == sz = z
+        | otherwise =
+            let !hi = I.index keys i
+                !(# v #) = I.index# vals i
+             in f lo hi v (go (i + 1) (succ hi))
+   in go 0 minBound
+
+foldlWithKeyM' :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Bounded k, Enum k, Monad m)
+  => (b -> k -> k -> v -> m b)
+  -> b
+  -> Map karr varr k v
+  -> m b
+foldlWithKeyM' f z (Map keys vals) =
+  let !sz = I.size vals
+      -- we must be lazy in the third argument
+      go !i !acc lo
+        | i == sz = return acc
+        | otherwise = do
+            let !hi = I.index keys i
+                !(# v #) = I.index# vals i
+            acc' <- f acc lo hi v
+            go (i + 1) acc' (succ hi)
+   in go 0 z minBound
+
+foldl' :: (Contiguous varr, Element varr v)
+  => (b -> v -> b)
+  -> b
+  -> Map karr varr k v
+  -> b
+foldl' f b0 (Map _ vals) = I.foldl' f b0 vals
+
+foldMap :: (Contiguous varr, Element varr v, Monoid m)
+  => (v -> m)
+  -> Map karr varr k v
+  -> m
+foldMap f (Map _ vals) = I.foldMap f vals
+
+toList :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Bounded k, Enum k)
+  => Map karr varr k v
+  -> [(k,k,v)]
+toList = foldrWithKey (\lo hi v xs -> (lo,hi,v) : xs) []
+
+fromList :: (Contiguous karr, Element karr k, Bounded k, Ord k, Enum k, Contiguous varr, Element varr v, Eq v)
+  => v -- value outside of the ranges
+  -> [(k,k,v)]
+  -> Map karr varr k v
+fromList def xs = concatWith
+  def
+  (\x y -> if x == def then y else x)
+  (P.map (\(lo,hi,v) -> singleton def lo hi v) xs)
+
+concatWith :: forall karr varr k v. (Contiguous karr, Bounded k, Element karr k, Ord k, Contiguous varr, Element varr v, Eq v)
+  => v -- value used if the list is empty
+  -> (v -> v -> v)
+  -> [Map karr varr k v]
+  -> Map karr varr k v
+concatWith def combine = C.concatSized size (pure def) (unionWith combine)
+
+concat :: (Contiguous karr, Bounded k, Element karr k, Ord k, Contiguous varr, Element varr v, Eq v, Monoid v)
+  => [Map karr varr k v]
+  -> Map karr varr k v
+concat = concatWith mempty mappend
+
+elems :: Map karr varr k v -> varr v
+elems (Map _ v) = v
+
diff --git a/src/Data/Map/Interval/DBTSLL.hs b/src/Data/Map/Interval/DBTSLL.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Interval/DBTSLL.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Data.Map.Interval.DBTSLL
+  ( Map
+  , pure
+  , singleton
+  , lookup
+  , fromList
+  , unionWith
+    -- * Mapping
+  , map
+  , mapBijection
+    -- * Traversals
+  , traverseBijectionP
+  , traverseBijection
+    -- * Folds
+  , foldl'
+  , foldMap
+  , foldrWithKey
+  , foldlWithKeyM'
+  , traverse_
+    -- * Conversion
+  , elems
+  ) where
+
+import Prelude hiding (lookup,map,pure,foldMap)
+
+import Data.Semigroup (Semigroup)
+import Data.Primitive.Array (Array)
+import Control.Monad.Primitive (PrimMonad)
+import qualified Data.Semigroup as SG
+import qualified Data.Map.Interval.DBTS.Internal as I
+import qualified GHC.Exts as E
+
+-- | A total interval map from keys @k@ to values @v@. The key type must be discrete
+--   and bounded. This map is strict in the values.
+newtype Map k v = Map (I.Map Array Array k v)
+
+instance (Eq k, Eq v) => Eq (Map k v) where
+  Map x == Map y = I.equals x y
+
+-- instance (Ord k, Ord v) => Ord (Map k v) where
+--   compare (Map x) (Map y) = I.compare x y
+
+instance (Ord k, Semigroup v, Eq v) => Semigroup (Map k v) where
+  Map x <> Map y = Map (I.union x y)
+
+-- The redundant constraint is needed for GHC < 8.4
+instance (Ord k, Bounded k, Semigroup v, Monoid v, Eq v) => Monoid (Map k v) where
+  mappend = (SG.<>) 
+  mempty = Map I.empty
+  mconcat = Map . I.concat . E.coerce
+
+instance (Bounded k, Enum k, Show k, Show v) => Show (Map k v) where
+  showsPrec p (Map m) = I.showsPrec p m
+
+instance (Bounded k, Enum k, Ord k, Eq v, Monoid v) => E.IsList (Map k v) where
+  type Item (Map k v) = (k,k,v)
+  fromList xs = Map (I.fromList mempty xs)
+  toList (Map m) = I.toList m
+
+pure :: Bounded k => v -> Map k v
+pure = Map . I.pure 
+
+singleton :: (Bounded k, Enum k, Ord k, Eq v)
+  => v -- ^ value outside of the interval
+  -> k -- ^ lower bound
+  -> k -- ^ upper bound
+  -> v -- ^ value inside the interval
+  -> Map k v
+singleton def lo hi v = Map (I.singleton def lo hi v)
+
+lookup :: Ord k => k -> Map k v -> v
+lookup k (Map m) = I.lookup k m
+
+-- | Create an interval map from a list of range-value triples. The first
+--   argument is a default value used everywhere outside of the given
+--   ranges. In the case of overlapping ranges, the leftmost value is
+--   used.
+fromList :: (Bounded k, Ord k, Enum k, Eq v)
+  => v -- ^ value outside of the ranges
+  -> [(k,k,v)] -- ^ low-high inclusive ranges with their corresponding values
+  -> Map k v
+fromList def xs = Map (I.fromList def xs)
+
+-- | This only provides a correct result when the effectful mapping
+--   is a bijection.
+traverseBijectionP :: PrimMonad m
+  => (v -> m w) -> Map k v -> m (Map k w)
+traverseBijectionP f (Map m) = fmap Map (I.traverseP f m)
+
+-- | This only provides a correct result when the effectful mapping
+--   is a bijection.
+traverseBijection :: Applicative m
+  => (v -> m w) -> Map k v -> m (Map k w)
+traverseBijection f (Map m) = fmap Map (I.traverse f m)
+
+traverse_ :: Applicative m => (v -> m w) -> Map k v -> m ()
+traverse_ f (Map m) = I.traverse_ f m
+
+mapBijection :: (v -> w) -> Map k v -> Map k w
+mapBijection f (Map m) = Map (I.mapBijection f m)
+
+map :: Eq w => (v -> w) -> Map k v -> Map k w
+map f (Map m) = Map (I.map f m)
+
+foldl' :: 
+     (b -> v -> b)
+  -> b
+  -> Map k v
+  -> b
+foldl' f b0 (Map m) = I.foldl' f b0 m
+
+foldMap :: (Monoid m)
+  => (v -> m)
+  -> Map k v
+  -> m
+foldMap f (Map m) = I.foldMap f m
+
+unionWith :: (Ord k, Eq c)
+  => (a -> b -> c)
+  -> Map k a
+  -> Map k b
+  -> Map k c
+unionWith f (Map a) (Map b) = Map (I.unionWith f a b)
+
+foldrWithKey :: (Bounded k, Enum k)
+  => (k -> k -> v -> b -> b)
+  -> b
+  -> Map k v
+  -> b
+foldrWithKey f z (Map m) = I.foldrWithKey f z m
+
+foldlWithKeyM' :: (Bounded k, Enum k, Monad m)
+  => (b -> k -> k -> v -> m b)
+  -> b
+  -> Map k v
+  -> m b
+foldlWithKeyM' f z (Map m) = I.foldlWithKeyM' f z m
+
+elems :: Map k v -> Array v
+elems (Map m) = I.elems m
+
diff --git a/src/Data/Map/Lifted/Lifted.hs b/src/Data/Map/Lifted/Lifted.hs
--- a/src/Data/Map/Lifted/Lifted.hs
+++ b/src/Data/Map/Lifted/Lifted.hs
@@ -13,6 +13,7 @@
   , map
   , mapMaybe
   , mapMaybeWithKey
+  , appendWithKey
   , union
     -- * Folds
   , foldlWithKey'
@@ -24,11 +25,13 @@
   , foldlMapWithKeyM'
   , foldrMapWithKeyM'
     -- * List Conversion
+  , toList
   , fromList
   , fromListAppend
   , fromListN
   , fromListAppendN
   , fromSet
+  , keys
   , elems
   ) where
 
@@ -41,8 +44,7 @@
 import qualified Data.Semigroup as SG
 import qualified Data.Map.Internal as I
 
--- | A map from keys @k@ to values @v@. The key type and the value
---   type must both have 'Prim' instances.
+-- | A map from keys @k@ to values @v@.
 newtype Map k v = Map (I.Map Array Array k v)
 
 instance Functor (Map k) where
@@ -83,6 +85,10 @@
 singleton :: k -> v -> Map k v
 singleton k v = Map (I.singleton k v)
 
+-- | /O(n)/ A list of key-value pairs in ascending order.
+toList :: Ord k => Map k v -> [(k,v)]
+toList (Map m) = I.toList m
+
 -- | /O(n*log n)/ Create a map from a list of key-value pairs.
 -- If the list contains more than one value for the same key,
 -- the last value is retained. If the keys in the argument are
@@ -152,6 +158,13 @@
   -> Map k w
 mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)
 
+appendWithKey :: Ord k
+  => (k -> v -> v -> v)
+  -> Map k v
+  -> Map k v
+  -> Map k v
+appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)
+
 -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold
 -- is strict in the accumulator.
 foldlWithKeyM' :: Monad m
@@ -218,6 +231,10 @@
 -- of @t1@ and @t2@. It prefers @t1@ when duplicate keys are encountered.
 union :: Ord k => Map k v -> Map k v -> Map k v
 union (Map a) (Map b) = Map (I.appendWith const a b)
+
+-- | /O(1)/ The values in a map. This is a zero-cost operation.
+keys :: Map k v -> Set k
+keys (Map m) = Set (I.keys m)
 
 -- | /O(1)/ The values in a map. This is a zero-cost operation.
 elems :: Map k v -> Array v
diff --git a/src/Data/Map/Lifted/Unlifted.hs b/src/Data/Map/Lifted/Unlifted.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Lifted/Unlifted.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -O2 -Wall #-}
+module Data.Map.Lifted.Unlifted
+  ( Map(..)
+  , empty
+  , singleton
+  , lookup
+  , size
+  , map
+  , mapMaybe
+  , mapMaybeWithKey
+  , appendWithKey
+  , union
+    -- * Folds
+  , foldlWithKey'
+  , foldrWithKey'
+  , foldMapWithKey'
+    -- * Monadic Folds
+  , foldlWithKeyM'
+  , foldrWithKeyM'
+  , foldlMapWithKeyM'
+  , foldrMapWithKeyM'
+    -- * List Conversion
+  , toList
+  , fromList
+  , fromListAppend
+  , fromListN
+  , fromListAppendN
+  , fromSet
+  , elems
+  ) where
+
+import Prelude hiding (lookup,map)
+
+import Data.Semigroup (Semigroup)
+import Data.Primitive (Array,UnliftedArray,PrimUnlifted)
+import Data.Set.Lifted.Internal (Set(..))
+import qualified GHC.Exts as E
+import qualified Data.Semigroup as SG
+import qualified Data.Map.Internal as I
+
+-- | A map from keys @k@ to values @v@.
+newtype Map k v = Map (I.Map Array UnliftedArray k v)
+
+instance (Ord k, Semigroup v, PrimUnlifted v) => Semigroup (Map k v) where
+  Map x <> Map y = Map (I.append x y)
+
+instance (Ord k, Semigroup v, PrimUnlifted v) => Monoid (Map k v) where
+  mempty = Map I.empty
+  mappend = (SG.<>)
+  mconcat = Map . I.concat . E.coerce
+
+instance (Eq k, Eq v, PrimUnlifted v) => Eq (Map k v) where
+  Map x == Map y = I.equals x y
+
+instance (Ord k, Ord v, PrimUnlifted v) => Ord (Map k v) where
+  compare (Map x) (Map y) = I.compare x y
+
+instance (Ord k, PrimUnlifted v) => E.IsList (Map k v) where
+  type Item (Map k v) = (k,v)
+  fromListN n = Map . I.fromListN n
+  fromList = Map . I.fromList
+  toList (Map s) = I.toList s
+
+instance (Show k, Show v, PrimUnlifted v) => Show (Map k v) where
+  showsPrec p (Map s) = I.showsPrec p s
+
+-- | The empty diet map.
+empty :: Map k v
+empty = Map I.empty
+
+-- | /O(log n)/ Lookup the value at a key in the map.
+lookup :: (Ord k, PrimUnlifted v) => k -> Map k v -> Maybe v
+lookup a (Map s) = I.lookup a s
+
+-- | /O(1)/ Create a map with a single element.
+singleton :: PrimUnlifted v => k -> v -> Map k v
+singleton k v = Map (I.singleton k v)
+
+-- | /O(n)/ A list of key-value pairs in ascending order.
+toList :: (Ord k, PrimUnlifted v) => Map k v -> [(k,v)]
+toList (Map m) = I.toList m
+
+-- | /O(n*log n)/ Create a map from a list of key-value pairs.
+-- If the list contains more than one value for the same key,
+-- the last value is retained. If the keys in the argument are
+-- in nondescending order, this algorithm runs in /O(n)/ time instead.
+fromList :: (Ord k, PrimUnlifted v) => [(k,v)] -> Map k v
+fromList = Map . I.fromList
+
+-- | /O(n*log n)/ This function has the same behavior as 'fromList'
+-- regardless of whether or not the expected size is accurate. Additionally,
+-- negative sizes are handled correctly. The expected size is used as the
+-- size of the initially allocated buffer when building the 'Map'. If the
+-- keys in the argument are in nondescending order, this algorithm runs
+-- in /O(n)/ time.
+fromListN :: (Ord k, PrimUnlifted v)
+  => Int -- ^ expected size of resulting 'Map'
+  -> [(k,v)] -- ^ key-value pairs
+  -> Map k v
+fromListN n = Map . I.fromListN n
+
+-- | /O(n*log n)/ This function has the same behavior as 'fromList',
+-- but it combines values with the 'Semigroup' instances instead of
+-- choosing the last occurrence.
+fromListAppend :: (Ord k, Semigroup v, PrimUnlifted v) => [(k,v)] -> Map k v
+fromListAppend = Map . I.fromListAppend
+
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by apply the given function to each key.
+fromSet :: PrimUnlifted v
+  => (k -> v)
+  -> Set k
+  -> Map k v
+fromSet f (Set s) = Map (I.fromSet f s)
+
+-- | /O(n*log n)/ This function has the same behavior as 'fromListN',
+-- but it combines values with the 'Semigroup' instances instead of
+-- choosing the last occurrence.
+fromListAppendN :: (Ord k, Semigroup v, PrimUnlifted v)
+  => Int -- ^ expected size of resulting 'Map'
+  -> [(k,v)] -- ^ key-value pairs
+  -> Map k v
+fromListAppendN n = Map . I.fromListAppendN n
+
+-- | /O(1)/ The number of elements in the map.
+size :: Map k v -> Int
+size (Map m) = I.sizeKeys m
+
+-- | /O(n)/ Map over the values in the map.
+map :: (PrimUnlifted v, PrimUnlifted w)
+  => (v -> w)
+  -> Map k v
+  -> Map k w
+map f (Map m) = Map (I.map f m)
+
+-- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
+mapMaybe :: (PrimUnlifted v, PrimUnlifted w)
+  => (v -> Maybe w)
+  -> Map k v
+  -> Map k w
+mapMaybe f (Map m) = Map (I.mapMaybe f m)
+
+-- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
+-- The predicate is given access to the key.
+mapMaybeWithKey :: (PrimUnlifted v, PrimUnlifted w)
+  => (k -> v -> Maybe w)
+  -> Map k v
+  -> Map k w
+mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)
+
+appendWithKey :: (Ord k, PrimUnlifted v)
+  => (k -> v -> v -> v)
+  -> Map k v
+  -> Map k v
+  -> Map k v
+appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)
+
+-- | /O(n)/ Left monadic fold over the keys and values of the map. This fold
+-- is strict in the accumulator.
+foldlWithKeyM' :: (Monad m, PrimUnlifted v)
+  => (b -> k -> v -> m b) -- ^ reduction
+  -> b -- ^ initial accumulator
+  -> Map k v -- ^ map
+  -> m b
+foldlWithKeyM' f b0 (Map m) = I.foldlWithKeyM' f b0 m
+
+-- | /O(n)/ Right monadic fold over the keys and values of the map. This fold
+-- is strict in the accumulator.
+foldrWithKeyM' :: (Monad m, PrimUnlifted v)
+  => (k -> v -> b -> m b) -- ^ reduction
+  -> b -- ^ initial accumulator
+  -> Map k v -- ^ map
+  -> m b
+foldrWithKeyM' f b0 (Map m) = I.foldrWithKeyM' f b0 m
+
+-- | /O(n)/ Monadic left fold over the keys and values of the map with a strict
+-- monoidal accumulator. The monoidal accumulator is appended to the left
+-- after each reduction.
+foldlMapWithKeyM' :: (Monad m, Monoid b, PrimUnlifted v)
+  => (k -> v -> m b) -- ^ reduction
+  -> Map k v -- ^ map
+  -> m b
+foldlMapWithKeyM' f (Map m) = I.foldlMapWithKeyM' f m
+
+-- | /O(n)/ Monadic right fold over the keys and values of the map with a strict
+-- monoidal accumulator. The monoidal accumulator is appended to the right
+-- after each reduction.
+foldrMapWithKeyM' :: (Monad m, Monoid b, PrimUnlifted v)
+  => (k -> v -> m b) -- ^ reduction
+  -> Map k v -- ^ map
+  -> m b
+foldrMapWithKeyM' f (Map m) = I.foldrMapWithKeyM' f m
+
+-- | /O(n)/ Fold over the keys and values of the map with a strict monoidal
+-- accumulator. This function does not have left and right variants since
+-- the associativity required by a monoid instance means that both variants
+-- would always produce the same result.
+foldMapWithKey' :: (Monoid b, PrimUnlifted v)
+  => (k -> v -> b) -- ^ reduction 
+  -> Map k v -- ^ map
+  -> b
+foldMapWithKey' f (Map m) = I.foldMapWithKey' f m
+
+-- | /O(n)/ Left fold over the keys and values with a strict accumulator.
+foldlWithKey' :: PrimUnlifted v
+  => (b -> k -> v -> b) -- ^ reduction
+  -> b -- ^ initial accumulator
+  -> Map k v -- ^ map
+  -> b
+foldlWithKey' f b0 (Map m) = I.foldlWithKey' f b0 m
+
+-- | /O(n)/ Right fold over the keys and values with a strict accumulator.
+foldrWithKey' :: PrimUnlifted v
+  => (k -> v -> b -> b) -- ^ reduction
+  -> b -- ^ initial accumulator
+  -> Map k v -- ^ map
+  -> b
+foldrWithKey' f b0 (Map m) = I.foldrWithKey' f b0 m
+
+-- | /O(n+m)/ The expression (@'union' t1 t2@) takes the left-biased union
+-- of @t1@ and @t2@. It prefers @t1@ when duplicate keys are encountered.
+union :: (Ord k, PrimUnlifted v) => Map k v -> Map k v -> Map k v
+union (Map a) (Map b) = Map (I.appendWith const a b)
+
+-- | /O(1)/ The values in a map. This is a zero-cost operation.
+elems :: Map k v -> UnliftedArray v
+elems (Map m) = I.elems m
+
+
diff --git a/src/Data/Map/Unboxed/Lifted.hs b/src/Data/Map/Unboxed/Lifted.hs
--- a/src/Data/Map/Unboxed/Lifted.hs
+++ b/src/Data/Map/Unboxed/Lifted.hs
@@ -13,9 +13,12 @@
   , map
   , mapMaybe
   , mapMaybeWithKey
+  , mapWithKey
   , keys
   , intersectionWith
+  , intersectionsWith
   , restrict
+  , appendWithKey
     -- * Folds
   , foldrWithKey
   , foldlWithKey'
@@ -33,6 +36,7 @@
   , fromListAppend
   , fromListN
   , fromListAppendN
+  , fromSet
   , elems
     -- * Array Conversion
   , unsafeFreezeZip
@@ -42,14 +46,16 @@
 
 import Control.DeepSeq (NFData)
 import Control.Monad.ST (ST)
-import Data.Semigroup (Semigroup)
-import Data.Primitive.Types (Prim)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Primitive (PrimArray,Array,MutablePrimArray,MutableArray)
+import Data.Primitive.Types (Prim)
+import Data.Semigroup (Semigroup)
 import Data.Set.Unboxed.Internal (Set(..))
+
 import qualified Control.DeepSeq
-import qualified GHC.Exts as E
-import qualified Data.Semigroup as SG
 import qualified Data.Map.Internal as I
+import qualified Data.Semigroup as SG
+import qualified GHC.Exts as E
 
 -- | A map from keys @k@ to values @v@. The key type must have a
 --   'Prim' instance and the value type is unconstrained.
@@ -94,11 +100,11 @@
 empty = Map I.empty
 
 -- | /O(1)/ Create a map with a single element.
-singleton :: (Prim k) => k -> v -> Map k v
+singleton :: Prim k => k -> v -> Map k v
 singleton k v = Map (I.singleton k v)
 
 -- | /O(n)/ A list of key-value pairs in ascending order.
-toList :: (Prim k, Ord k, Prim v) => Map k v -> [(k,v)]
+toList :: (Prim k, Ord k) => Map k v -> [(k,v)]
 toList (Map m) = I.toList m
 
 -- | /O(n*log n)/ Create a map from a list of key-value pairs.
@@ -135,6 +141,15 @@
   -> Map k v
 fromListAppendN n = Map . I.fromListAppendN n
 
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by applying the given function to each key.
+fromSet :: Prim k
+  => (k -> v)
+  -> Set k
+  -> Map k v
+fromSet f (Set s) = Map (I.fromSet f s)
+
 -- | /O(1)/ The number of elements in the map.
 size :: Map k v -> Int
 size (Map m) = I.size m
@@ -161,6 +176,20 @@
   -> Map k w
 mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)
 
+-- | /O(n)/ Map over the elements with access to their corresponding keys.
+mapWithKey :: Prim k
+  => (k -> v -> w)
+  -> Map k v
+  -> Map k w
+mapWithKey f (Map m) = Map (I.mapWithKey f m)
+
+appendWithKey :: (Prim k, Ord k)
+  => (k -> v -> v -> v)
+  -> Map k v
+  -> Map k v
+  -> Map k v
+appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)
+
 -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold
 -- is strict in the accumulator.
 foldlWithKeyM' :: (Monad m, Prim k)
@@ -267,6 +296,15 @@
   -> Map k b
   -> Map k c
 intersectionWith f (Map a) (Map b) = Map (I.intersectionWith f a b)
+
+-- | Take the intersection of all of the maps, combining elements at
+-- equal keys with the provided function. Since intersection of maps lacks an
+-- identity, this is provided with a non-empty list.
+intersectionsWith :: (Prim k, Ord k)
+  => (v -> v -> v)
+  -> NonEmpty (Map k v)
+  -> Map k v
+intersectionsWith f xs = Map (I.intersectionsWith f (E.coerce xs))
 
 restrict :: (Prim k, Ord k)
   => Map k v
diff --git a/src/Data/Map/Unboxed/Unboxed.hs b/src/Data/Map/Unboxed/Unboxed.hs
--- a/src/Data/Map/Unboxed/Unboxed.hs
+++ b/src/Data/Map/Unboxed/Unboxed.hs
@@ -10,9 +10,12 @@
   , singleton
   , lookup
   , size
+    -- * Transform
   , map
   , mapMaybe
   , mapMaybeWithKey
+  , adjustMany
+  , adjustManyInline
     -- * Folds
   , foldlWithKey'
   , foldrWithKey'
@@ -30,19 +33,25 @@
   , fromListAppend
   , fromListN
   , fromListAppendN
+  , fromSet
+  , fromSetP
     -- * Array Conversion
   , unsafeFreezeZip
   ) where
 
 import Prelude hiding (lookup,map)
 
+import Control.Monad.Primitive (PrimMonad)
 import Control.Monad.ST (ST)
-import Data.Semigroup (Semigroup)
-import Data.Primitive.Types (Prim)
 import Data.Primitive.PrimArray (PrimArray,MutablePrimArray)
-import qualified GHC.Exts as E
-import qualified Data.Semigroup as SG
+import Data.Primitive.Types (Prim)
+import Data.Semigroup (Semigroup)
+import Data.Set.Unboxed.Internal (Set(..))
+import GHC.Exts (inline)
+
 import qualified Data.Map.Internal as I
+import qualified Data.Semigroup as SG
+import qualified GHC.Exts as E
 
 -- | A map from keys @k@ to values @v@. The key type and the value
 --   type must both have 'Prim' instances.
@@ -121,6 +130,25 @@
   -> Map k v
 fromListAppendN n = Map . I.fromListAppendN n
 
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by apply the given function to each key.
+fromSet :: (Prim k, Prim v)
+  => (k -> v)
+  -> Set k
+  -> Map k v
+fromSet f (Set s) = Map (I.fromSet f s)
+
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by apply the given function to each key. The function can perform
+-- primitive monadic effects.
+fromSetP :: (PrimMonad m, Prim k, Prim v)
+  => (k -> m v)
+  -> Set k
+  -> m (Map k v)
+fromSetP f (Set s) = fmap Map (I.fromSetP f s)
+
 -- | /O(1)/ The number of elements in the map.
 size :: Prim v => Map k v -> Int
 size (Map m) = I.size m
@@ -146,6 +174,39 @@
   -> Map k v
   -> Map k w
 mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)
+
+-- | Update the values at any number of keys. This is done
+-- on in a buffer without building intermediate maps. Example use:
+--
+-- > adjustMany
+-- >   (\adjust -> do
+-- >     adjust 2 (\x -> pure (x + 1))
+-- >     adjust 3 (\_ -> pure 42)
+-- >   ) myMap
+--
+-- This increments by 1 the value associated with key 2. Then,
+-- it replaces with 42 the value associated with key 3.
+adjustMany :: (Prim k, Prim v, PrimMonad m, Ord k)
+  => ((k -> (v -> m v) -> m ()) -> m a) -- ^ Modification-applying function
+  -> Map k v -- ^ Map
+  -> m (Map k v, a)
+{-# INLINABLE adjustMany #-}
+adjustMany f (Map m) = do
+  (r,a) <- I.adjustMany f m
+  pure (Map r, a)
+
+-- | This has the same behavior as 'adjustMany'. However, it will be
+--   inlined rather than specialized. The can prevent needless boxing
+--   in the callback. Use @-ddump-simpl@ and standard profiling techniques
+--   to figure out if this function actually helps you.
+adjustManyInline :: (Prim k, Prim v, PrimMonad m, Ord k)
+  => ((k -> (v -> m v) -> m ()) -> m a) -- ^ Modification-applying function
+  -> Map k v -- ^ Map
+  -> m (Map k v, a)
+{-# INLINE adjustManyInline #-}
+adjustManyInline f (Map m) = do
+  (r,a) <- I.adjustManyInline f m
+  pure (Map r, a)
 
 -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold
 -- is strict in the accumulator.
diff --git a/src/Data/Map/Unboxed/Unlifted.hs b/src/Data/Map/Unboxed/Unlifted.hs
--- a/src/Data/Map/Unboxed/Unlifted.hs
+++ b/src/Data/Map/Unboxed/Unlifted.hs
@@ -10,9 +10,12 @@
   , singleton
   , lookup
   , size
+    -- * Transform
   , map
   , mapMaybe
+  , mapMaybeP
   , mapMaybeWithKey
+  , adjustMany
     -- * Folds
   , foldlWithKey'
   , foldrWithKey'
@@ -22,25 +25,32 @@
   , foldrWithKeyM'
   , foldlMapWithKeyM'
   , foldrMapWithKeyM'
+    -- * Traversals
+  , traverse
     -- * List Conversion
   , fromList
   , fromListAppend
   , fromListN
   , fromListAppendN
+  , fromSet
+  , fromSetP
     -- * Array Conversion
   , unsafeFreezeZip
   ) where
 
-import Prelude hiding (lookup,map)
+import Prelude hiding (lookup,map,traverse)
 
-import Data.Semigroup (Semigroup)
+import Control.Monad.Primitive (PrimMonad)
+import Control.Monad.ST (ST)
+import Data.Primitive (PrimArray,MutablePrimArray)
 import Data.Primitive.Types (Prim)
 import Data.Primitive.UnliftedArray (PrimUnlifted,UnliftedArray,MutableUnliftedArray)
-import Data.Primitive (PrimArray,MutablePrimArray)
-import Control.Monad.ST (ST)
-import qualified GHC.Exts as E
-import qualified Data.Semigroup as SG
+import Data.Semigroup (Semigroup)
+import Data.Set.Unboxed.Internal (Set(..))
+
 import qualified Data.Map.Internal as I
+import qualified Data.Semigroup as SG
+import qualified GHC.Exts as E
 
 -- | A map from keys @k@ to values @v@. The key type and the value
 --   type must both have 'Prim' instances.
@@ -115,6 +125,27 @@
   -> Map k v
 fromListAppendN n = Map . I.fromListAppendN n
 
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by apply the given function to each key.
+fromSet :: (Prim k, PrimUnlifted v)
+  => (k -> v)
+  -> Set k
+  -> Map k v
+{-# INLINE fromSet #-}
+fromSet f (Set s) = Map (I.fromSet f s)
+
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by apply the given function to each key. The function can perform
+-- primitive monadic effects.
+fromSetP :: (PrimMonad m, Prim k, PrimUnlifted v)
+  => (k -> m v)
+  -> Set k
+  -> m (Map k v)
+{-# INLINE fromSetP #-}
+fromSetP f (Set s) = fmap Map (I.fromSetP f s)
+
 -- | /O(1)/ The number of elements in the map.
 size :: PrimUnlifted v => Map k v -> Int
 size (Map m) = I.size m
@@ -131,9 +162,18 @@
   => (v -> Maybe w)
   -> Map k v
   -> Map k w
+{-# INLINE mapMaybe #-}
 mapMaybe f (Map m) = Map (I.mapMaybe f m)
 
 -- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
+mapMaybeP :: (PrimMonad m, Prim k, PrimUnlifted v, PrimUnlifted w)
+  => (v -> m (Maybe w))
+  -> Map k v
+  -> m (Map k w)
+{-# INLINE mapMaybeP #-}
+mapMaybeP f (Map m) = fmap Map (I.mapMaybeP f m)
+
+-- | /O(n)/ Drop elements for which the predicate returns 'Nothing'.
 -- The predicate is given access to the key.
 mapMaybeWithKey :: (Prim k, PrimUnlifted v, PrimUnlifted w)
   => (k -> v -> Maybe w)
@@ -141,6 +181,25 @@
   -> Map k w
 mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)
 
+-- | Update the values at any number of keys. This is done
+-- on in a buffer without building intermediate maps. Example use:
+--
+-- > adjustMany
+-- >   (\adjust -> do
+-- >     adjust 2 (\x -> pure (x + 1))
+-- >     adjust 3 (\_ -> pure 42)
+-- >   ) myMap
+--
+-- This increments by 1 the value associated with key 2. Then,
+-- it replaces with 42 the value associated with key 3.
+adjustMany :: (Prim k, PrimUnlifted v, PrimMonad m, Ord k)
+  => ((k -> (v -> m v) -> m ()) -> m a) -- ^ Modification-applying function
+  -> Map k v -- ^ Map
+  -> m (Map k v, a)
+adjustMany f (Map m) = do
+  (r,a) <- I.adjustMany f m
+  pure (Map r, a)
+
 -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold
 -- is strict in the accumulator.
 foldlWithKeyM' :: (Monad m, Prim k, PrimUnlifted v)
@@ -176,6 +235,13 @@
   -> Map k v -- ^ map
   -> m b
 foldrMapWithKeyM' f (Map m) = I.foldrMapWithKeyM' f m
+
+-- | /O(n)/ Traverse the values of the map.
+traverse :: (Applicative m, Prim k, PrimUnlifted v, PrimUnlifted w)
+  => (v -> m w)
+  -> Map k v
+  -> m (Map k w)
+traverse f (Map m) = fmap Map (I.traverse f m)
 
 -- | /O(n)/ Fold over the keys and values of the map with a strict monoidal
 -- accumulator. This function does not have left and right variants since
diff --git a/src/Data/Map/Unlifted/Lifted.hs b/src/Data/Map/Unlifted/Lifted.hs
--- a/src/Data/Map/Unlifted/Lifted.hs
+++ b/src/Data/Map/Unlifted/Lifted.hs
@@ -110,15 +110,6 @@
 fromListAppend :: (PrimUnlifted k, Ord k, Semigroup v) => [(k,v)] -> Map k v
 fromListAppend = Map . I.fromListAppend
 
--- | /O(n)/ Build a map from a set. This function is uses the underlying
--- array that backs the set as the array for the keys. It constructs the
--- values by apply the given function to each key.
-fromSet :: PrimUnlifted k
-  => (k -> v)
-  -> Set k
-  -> Map k v
-fromSet f (Set s) = Map (I.fromSet f s)
-
 -- | /O(n*log n)/ This function has the same behavior as 'fromListN',
 -- but it combines values with the 'Semigroup' instances instead of
 -- choosing the last occurrence.
@@ -127,6 +118,15 @@
   -> [(k,v)] -- ^ key-value pairs
   -> Map k v
 fromListAppendN n = Map . I.fromListAppendN n
+
+-- | /O(n)/ Build a map from a set. This function is uses the underlying
+-- array that backs the set as the array for the keys. It constructs the
+-- values by applying the given function to each key.
+fromSet :: PrimUnlifted k
+  => (k -> v)
+  -> Set k
+  -> Map k v
+fromSet f (Set s) = Map (I.fromSet f s)
 
 -- | /O(1)/ The number of elements in the map.
 size :: Map k v -> Int
diff --git a/src/Data/Set/Internal.hs b/src/Data/Set/Internal.hs
--- a/src/Data/Set/Internal.hs
+++ b/src/Data/Set/Internal.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wall #-}
@@ -12,6 +13,8 @@
   , empty
   , null
   , singleton
+  , doubleton
+  , tripleton
   , difference
   , intersection
   , append
@@ -25,6 +28,8 @@
   , toArray
   , size
   , concat
+  , subset
+  , enumFromTo
     -- * Folds
   , foldr
   , foldMap
@@ -36,9 +41,10 @@
     -- * Traversals
   , traverse_
   , itraverse_
+  , map
   ) where
 
-import Prelude hiding (compare,showsPrec,concat,foldr,foldMap,null)
+import Prelude hiding (compare,showsPrec,concat,foldr,foldMap,null,map,enumFromTo)
 
 import Control.Monad.ST (ST,runST)
 import Data.Hashable (Hashable)
@@ -69,6 +75,10 @@
 compare :: (Contiguous arr, Element arr a, Ord a) => Set arr a -> Set arr a -> Ordering
 compare (Set x) (Set y) = compareArr x y
 
+-- Only correct if the function is a monotone.
+map :: (Contiguous arr, Element arr a, Element arr b) => (a -> b) -> Set arr a -> Set arr b
+map f (Set x) = Set (A.map f x)
+
 fromListN :: (Contiguous arr, Element arr a, Ord a) => Int -> [a] -> Set arr a
 fromListN n xs = -- fromList xs
   case xs of
@@ -80,6 +90,35 @@
 fromList :: (Contiguous arr, Element arr a, Ord a) => [a] -> Set arr a
 fromList = fromListN 1
 
+-- This is intended to be used with things like Word8,Int8,Word16,Int16,etc.
+-- It does the minimal number of allocations. It does some extra checks
+-- just in case someone write a bad Num instance for something. If
+-- you have a Num instance that doesn't satisfy the laws one would
+-- intuitively expect, this function will bail out and return
+-- the empty set.
+enumFromTo :: (Contiguous arr, Element arr a, Enum a, Ord a, Num a)
+  => a -- Low
+  -> a -- High
+  -> Set arr a
+enumFromTo !lo !hi = if hi >= lo
+  then runST $ do
+    let go !arr !ix !a !old = if ix >= 0
+          then if a < old
+            then A.write arr ix a *> go arr (ix - 1) (a - 1) a
+            else pure (Set A.empty)
+          else do
+            r <- A.unsafeFreeze arr
+            pure (Set r)
+    let total = fromEnum (hi - lo)
+    if total >= 0
+      then do
+        arr <- A.new (total + 1)
+        A.write arr total hi
+        go arr (total - 1) (hi - 1) hi
+      else pure (Set A.empty)
+  else Set A.empty
+
+
 difference :: forall a arr. (Contiguous arr, Element arr a, Ord a)
   => Set arr a
   -> Set arr a
@@ -214,11 +253,38 @@
       else EQ
 
 singleton :: (Contiguous arr, Element arr a) => a -> Set arr a
-singleton a = Set $ runST $ do
-  arr <- A.new 1
-  A.write arr 0 a
-  A.unsafeFreeze arr
+singleton a = Set (A.singleton a)
 
+doubleton :: (Contiguous arr, Element arr a, Ord a) => a -> a -> Set arr a
+doubleton a b = case P.compare a b of
+  LT -> Set (A.doubleton a b)
+  GT -> Set (A.doubleton b a)
+  EQ -> Set (A.singleton a)
+
+tripleton :: (Contiguous arr, Element arr a, Ord a) => a -> a -> a -> Set arr a
+tripleton a b c = case P.compare a b of
+  LT -> case P.compare b c of
+    LT -> Set (A.tripleton a b c)
+    EQ -> doubleton a b
+    GT -> case P.compare a c of
+      LT -> Set (A.tripleton a c b)
+      EQ -> doubleton a b
+      GT -> Set (A.tripleton c a b)
+  GT -> case P.compare b c of
+    LT -> case P.compare a c of
+      LT -> Set (A.tripleton b a c)
+      EQ -> doubleton b a
+      GT -> Set (A.tripleton b c a)
+    EQ -> doubleton b a
+    GT -> Set (A.tripleton c b a)
+  EQ -> doubleton b c
+
+-- The shortcuts help when:
+-- 
+-- * One of the arrays is empty. In this situation, we can just return
+--   the other array instead of reconstructing it.
+-- * All elements in one array are smaller than all elements in the
+--   other. In this case, we can append the arrays, which uses memcpy.
 unionArr :: forall arr a. (Contiguous arr, Element arr a, Ord a)
   => arr a -- array x
   -> arr a -- array y
@@ -226,6 +292,7 @@
 unionArr arrA arrB
   | szA < 1 = arrB
   | szB < 1 = arrA
+  | A.index arrA (szA - 1) < A.index arrB 0 = A.append arrA arrB
   | otherwise = runST $ do
       !(arrDst :: Mutable arr s a)  <- A.new (szA + szB)
       let go !ixA !ixB !ixDst = if ixA < szA
@@ -330,4 +397,50 @@
 liftHashWithSalt f s (Set arr) = A.liftHashWithSalt f s arr
 {-# INLINEABLE liftHashWithSalt #-}
 
+-- Returns true if the first set is a subset of the second set.
+-- This algorithm could be improved by performing some kind of
+-- galloping.
+subset :: (Contiguous arr, Element arr a, Ord a)
+  => Set arr a
+  -> Set arr a
+  -> Bool
+subset (Set arrA) (Set arrB) = go 0 0
+  where
+  !szA = A.size arrA
+  !szB = A.size arrB
+  go !ixA !ixB = if ixA < szA
+    then if ixB < szB
+      then
+        let !(# a #) = A.index# arrA ixA
+            !(# b #) = A.index# arrB ixB
+         in case P.compare a b of
+              LT -> False
+              EQ -> go (ixA + 1) (ixB + 1)
+              GT -> go ixA (ixB + 1)
+      else False
+    else True
 
+-- This relies on a sensible @Num@ instance for correctness. It is not totally
+-- correcty yet because of the existence of zero
+-- scale :: (Contiguous arr, Element arr a, Num a)
+--   => a
+--   -> Set arr a
+--   -> Set arr a
+-- scale x (Set arr) = Set (A.map' (x *)  arr)
+-- {-# INLINEABLE scale #-}
+
+-- Take the cross product of the two sets. That is, combine every
+-- element in @A@ with every element in @B@ using the provided function.
+-- If the combining function @f@ is an inequality morphism satisfying
+-- @forall x y w z. x >= y ==> f x w >= f y z@, then this algorithm runs
+-- in /O(n*m)/. Otherwise, it runs in @/O(n*m*log(n*m)/@.
+-- cross :: (Contiguous arr, Element arr a, Element arr b, Element arr c)
+--   => (a -> b -> c)
+--   -> Set arr a
+--   -> Set arr b
+--   -> Set arr c
+-- cross f (Set as) (Set bs) = runST $ do
+--   let !maxSz = A.size as * A.size bs
+--   !m <- A.new maxSz
+--   let go !ixA !ixB !ixCount !ixDst !morphism = if ixCount < maxSz
+--         then
diff --git a/src/Data/Set/Lifted.hs b/src/Data/Set/Lifted.hs
--- a/src/Data/Set/Lifted.hs
+++ b/src/Data/Set/Lifted.hs
@@ -14,6 +14,7 @@
   , difference
   , (\\)
   , intersection
+  , subset
     -- * Conversion
   , toArray
   , LI.toList
@@ -43,6 +44,10 @@
 -- | The intersection of two sets.
 intersection :: Ord a => Set a -> Set a -> Set a
 intersection (Set x) (Set y) = Set (I.intersection x y)
+
+-- | Is the first argument a subset of the second argument?
+subset :: Ord a => Set a -> Set a -> Bool
+subset (Set x) (Set y) = I.subset x y
 
 -- | The empty set.
 empty :: Set a
diff --git a/src/Data/Set/NonEmpty/Unlifted.hs b/src/Data/Set/NonEmpty/Unlifted.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Set/NonEmpty/Unlifted.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -O2 #-}
+module Data.Set.NonEmpty.Unlifted
+  ( Set
+  , singleton
+  , member
+  , size
+    -- * Conversion
+  , toArray
+  , toList
+  , fromNonEmpty
+  , toSet
+  , fromSet
+    -- * Folds
+  , foldr
+  , foldMap
+  , foldl'
+  , foldr'
+  , foldMap'
+    -- * Traversals
+  , traverse_
+  , itraverse_
+  ) where
+
+import Prelude hiding (foldr,foldMap,null)
+
+import Data.Hashable (Hashable)
+import Data.Primitive.UnliftedArray (PrimUnlifted(..),UnliftedArray)
+import Data.Semigroup (Semigroup)
+import Data.List.NonEmpty (NonEmpty)
+
+import qualified Data.Foldable as F
+import qualified Data.Hashable as H
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Semigroup as SG
+import qualified Data.Set.Internal as I
+import qualified GHC.Exts as E
+import qualified Data.Set.Unlifted as S
+import qualified Data.Set.Unlifted.Internal as SI
+
+newtype Set a = Set (I.Set UnliftedArray a)
+
+instance PrimUnlifted (Set a) where
+  toArrayArray# (Set x) = toArrayArray# x
+  fromArrayArray# y = Set (fromArrayArray# y)
+
+instance (Ord a, PrimUnlifted a) => Semigroup (Set a) where
+  Set x <> Set y = Set (I.append x y)
+  stimes = SG.stimesIdempotent
+  sconcat xs = Set (I.concat (E.coerce (F.toList xs)))
+
+instance (Hashable a, PrimUnlifted a) => Hashable (Set a) where
+  hashWithSalt s (Set arr) = I.liftHashWithSalt H.hashWithSalt s arr
+
+instance (PrimUnlifted a, Eq a) => Eq (Set a) where
+  Set x == Set y = I.equals x y
+
+instance (PrimUnlifted a, Ord a) => Ord (Set a) where
+  compare (Set x) (Set y) = I.compare x y
+
+instance (PrimUnlifted a, Show a) => Show (Set a) where
+  showsPrec p (Set s) = I.showsPrec p s
+
+-- | /O(n)/ Convert a set to a list. The elements are given in ascending order.
+toList :: PrimUnlifted a => Set a -> [a]
+toList (Set s) = I.toList s
+
+-- | /O(n*log n)/ Convert a list to a set.
+fromNonEmpty :: (PrimUnlifted a, Ord a) => NonEmpty a -> Set a
+fromNonEmpty = Set . I.fromList . NE.toList
+
+-- | /O(1)/ Convert a set to a non-empty set. This returns @Nothing@ if
+-- the set is empty. The resulting non-empty set shares internal
+-- represention as the argument.
+fromSet :: SI.Set a -> Maybe (Set a)
+fromSet s@(SI.Set x) = if S.null s
+  then Nothing
+  else Just (Set x)
+
+-- | /O(0)/ Convert a non-empty set to a set. The resulting set shares
+-- the internal representation with the argument.
+toSet :: Set a -> SI.Set a
+toSet = E.coerce
+
+-- | Test for membership in the set.
+member :: (PrimUnlifted a, Ord a) => a -> Set a -> Bool
+member a (Set s) = I.member a s
+
+-- | Construct a set with a single element.
+singleton :: PrimUnlifted a => a -> Set a
+singleton = Set . I.singleton
+
+-- | The number of elements in the set.
+size :: PrimUnlifted a => Set a -> Int
+size (Set s) = I.size s
+
+-- | /O(1)/ Convert a set to an array. The elements are given in ascending
+-- order. This function is zero-cost.
+toArray :: Set a -> UnliftedArray a
+toArray (Set s) = I.toArray s
+
+-- | Right fold over the elements in the set. This is lazy in the accumulator.
+foldr :: PrimUnlifted a
+  => (a -> b -> b)
+  -> b
+  -> Set a
+  -> b
+foldr f b0 (Set s) = I.foldr f b0 s
+
+-- | Monoidal fold over the elements in the set. This is lazy in the accumulator.
+foldMap :: (PrimUnlifted a, Monoid m)
+  => (a -> m)
+  -> Set a
+  -> m
+foldMap f (Set s) = I.foldMap f s
+
+-- | Strict left fold over the elements in the set.
+foldl' :: PrimUnlifted a
+  => (b -> a -> b)
+  -> b
+  -> Set a
+  -> b
+foldl' f b0 (Set s) = I.foldl' f b0 s
+
+-- | Strict right fold over the elements in the set.
+foldr' :: PrimUnlifted a
+  => (a -> b -> b)
+  -> b
+  -> Set a
+  -> b
+foldr' f b0 (Set s) = I.foldr' f b0 s
+
+-- | Strict monoidal fold over the elements in the set.
+foldMap' :: (PrimUnlifted a, Monoid m)
+  => (a -> m)
+  -> Set a
+  -> m
+foldMap' f (Set arr) = I.foldMap' f arr
+
+-- | Traverse a set, discarding the result.
+traverse_ :: (Applicative m, PrimUnlifted a)
+  => (a -> m b)
+  -> Set a
+  -> m ()
+traverse_ f (Set arr) = I.traverse_ f arr
+
+-- | Traverse a set with the indices, discarding the result.
+itraverse_ :: (Applicative m, PrimUnlifted a)
+  => (Int -> a -> m b)
+  -> Set a
+  -> m ()
+itraverse_ f (Set arr) = I.itraverse_ f arr
+
diff --git a/src/Data/Set/Unboxed.hs b/src/Data/Set/Unboxed.hs
--- a/src/Data/Set/Unboxed.hs
+++ b/src/Data/Set/Unboxed.hs
@@ -9,15 +9,20 @@
   ( S.Set
   , empty
   , singleton
+  , doubleton
+  , tripleton
   , null
   , member
   , size
   , difference
   , (\\)
   , intersection
+  , subset
+  , enumFromTo
     -- * List Conversion
   , S.toList
   , S.fromList
+  , toArray
     -- * Folds
   , foldr
   , foldMap
@@ -27,9 +32,10 @@
     -- * Traversals
   , traverse_
   , itraverse_
+  , mapMonotonic
   ) where
 
-import Prelude hiding (foldr,foldMap,null)
+import Prelude hiding (foldr,foldMap,null,enumFromTo)
 import Data.Hashable (Hashable)
 import Data.Primitive.PrimArray (PrimArray)
 import Data.Primitive.Types (Prim)
@@ -59,6 +65,18 @@
 intersection :: (Ord a, Prim a) => Set a -> Set a -> Set a
 intersection (Set x) (Set y) = Set (I.intersection x y)
 
+-- | Is the first argument a subset of the second argument?
+subset :: (Ord a, Prim a) => Set a -> Set a -> Bool
+subset (Set x) (Set y) = I.subset x y
+
+-- | The set that includes all elements from the lower bound to the
+-- upper bound.
+enumFromTo :: (Enum a, Ord a, Num a, Prim a)
+  => a -- ^ Inclusive lower bound
+  -> a -- ^ Inclusive upper bound
+  -> Set a
+enumFromTo lo hi = Set (I.enumFromTo lo hi)
+
 -- | Test whether or not an element is present in a set.
 member :: (Prim a, Ord a) => a -> Set a -> Bool
 member a (Set s) = I.member a s
@@ -71,6 +89,14 @@
 singleton :: Prim a => a -> Set a
 singleton = Set . I.singleton
 
+-- | Construct a set with two elements.
+doubleton :: (Prim a, Ord a) => a -> a -> Set a
+doubleton a b = Set (I.doubleton a b)
+
+-- | Construct a set with two elements.
+tripleton :: (Prim a, Ord a) => a -> a -> a -> Set a
+tripleton a b c = Set (I.tripleton a b c)
+
 -- | The number of elements in the set.
 size :: Prim a => Set a -> Int
 size (Set s) = I.size s
@@ -113,6 +139,11 @@
   -> m
 foldMap f (Set arr) = I.foldMap f arr
 
+-- | /O(1)/ Convert a set to an array. The elements are given in ascending
+-- order. This function is zero-cost.
+toArray :: Set a -> PrimArray a
+toArray (Set s) = I.toArray s
+
 -- | Traverse a set, discarding the result.
 traverse_ :: (Applicative m, Prim a)
   => (a -> m b)
@@ -127,4 +158,13 @@
   -> m ()
 itraverse_ f (Set arr) = I.itraverse_ f arr
 {-# INLINEABLE itraverse_ #-}
+
+-- | Map over the elements of a set. The provided function must be
+-- monotonic.
+mapMonotonic :: (Prim a, Prim b)
+  => (a -> b)
+  -> Set a
+  -> Set b
+mapMonotonic f (Set arr) = Set (I.map f arr)
+{-# INLINEABLE mapMonotonic #-}
 
diff --git a/src/Data/Set/Unlifted.hs b/src/Data/Set/Unlifted.hs
--- a/src/Data/Set/Unlifted.hs
+++ b/src/Data/Set/Unlifted.hs
@@ -14,6 +14,7 @@
   , size
   , difference
   , intersection
+  , enumFromTo
     -- * Conversion
   , toArray
   , S.toList
@@ -29,7 +30,7 @@
   , itraverse_
   ) where
 
-import Prelude hiding (foldr,foldMap,null)
+import Prelude hiding (foldr,foldMap,null,enumFromTo)
 
 import Data.Primitive.UnliftedArray (UnliftedArray, PrimUnlifted(..))
 import Data.Semigroup (Semigroup)
@@ -64,6 +65,14 @@
 -- | The intersection of two sets.
 intersection :: (Ord a, PrimUnlifted a) => Set a -> Set a -> Set a
 intersection (Set x) (Set y) = Set (I.intersection x y)
+
+-- | The set that includes all elements from the lower bound to the
+-- upper bound.
+enumFromTo :: (Enum a, Ord a, Num a, PrimUnlifted a)
+  => a -- ^ Inclusive lower bound
+  -> a -- ^ Inclusive upper bound
+  -> Set a
+enumFromTo lo hi = Set (I.enumFromTo lo hi)
 
 -- | /O(1)/ Convert a set to an array. The elements are given in ascending
 -- order. This function is zero-cost.
diff --git a/src/Data/Set/Unlifted/Internal.hs b/src/Data/Set/Unlifted/Internal.hs
--- a/src/Data/Set/Unlifted/Internal.hs
+++ b/src/Data/Set/Unlifted/Internal.hs
@@ -16,7 +16,6 @@
 import Data.Primitive.UnliftedArray (PrimUnlifted(..),UnliftedArray)
 import Data.Primitive (Array)
 import Data.Semigroup (Semigroup)
-import Text.Show (showListWith)
 
 import qualified Data.Foldable as F
 import qualified Data.Hashable as H
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -18,31 +18,32 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 import Data.Primitive
-import Data.Primitive.UnliftedArray (PrimUnlifted)
 import Data.Word
-import Data.Proxy (Proxy(..))
 import Data.Int
-import Data.Functor.Const (Const(..))
-import Data.Kind (Type)
 
-import Test.Tasty (defaultMain,testGroup,TestTree)
-import Test.Tasty.HUnit (testCase,(@?=))
-import Test.QuickCheck (Arbitrary,Gen,(===),(==>))
-import Test.HUnit.Base (assertEqual)
+import Control.Applicative (liftA2)
+import Control.Monad (forM)
 import Data.Bool (bool)
-import Data.List.NonEmpty (NonEmpty((:|)))
-import Data.Exists (ToSing(..),DependentPair(..),ShowForall(..),ShowForeach(..))
-import Data.Exists (WitnessedEquality(..),WitnessedOrdering(..),EqForall(..),OrdForall(..))
+import Data.Continuous.Set.Lifted (Inclusivity(..))
+import Data.Dependent.Map.Class (Universally(..),ApplyUniversally(..))
 import Data.Exists (EqForeach(..),OrdForeach(..),EqForallPoly(..),OrdForallPoly(..),Sing)
+import Data.Exists (FromJSONForeach(..),SemigroupForeach(..))
 import Data.Exists (PrimForall(..),ToJSONKeyForall(..),ToJSONKeyFunctionForall(..))
 import Data.Exists (ToJSONForeach(..),FromJSONKeyExists(..),Exists(..))
-import Data.Exists (FromJSONForeach(..))
-import Control.Monad (forM)
+import Data.Exists (ToSing(..),DependentPair(..),ShowForall(..),ShowForeach(..))
+import Data.Exists (WitnessedEquality(..),WitnessedOrdering(..),EqForall(..),OrdForall(..))
+import Data.Functor.Const (Const(..))
+import Data.Kind (Type)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Primitive.UnliftedArray (PrimUnlifted)
+import Data.Proxy (Proxy(..))
 import Data.Semigroup (Semigroup)
-import Unsafe.Coerce (unsafeCoerce)
-import Data.Dependent.Map.Class (Universally(..),ApplyUniversally(..))
+import Test.HUnit.Base (assertEqual)
+import Test.QuickCheck (Arbitrary,Gen,(===),(==>))
+import Test.Tasty (defaultMain,testGroup,TestTree)
+import Test.Tasty.HUnit (testCase,(@?=))
 import Text.Read (readMaybe)
-import Data.Continuous.Set.Lifted (Inclusivity(..))
+import Unsafe.Coerce (unsafeCoerce)
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Encoding as AEE
 import qualified Data.Text as T
@@ -59,6 +60,8 @@
 import qualified Data.Set.Unboxed as SU
 import qualified Data.Set.Lifted as SL
 import qualified Data.Set.Unlifted as SUL
+import qualified Data.Map.Lifted.Lifted as MLL
+import qualified Data.Map.Unboxed.Lifted as MUL
 import qualified Data.Map.Unboxed.Unboxed as MUU
 import qualified Data.Diet.Map.Strict.Unboxed.Lifted as DMUL
 import qualified Data.Diet.Map.Strict.Lifted.Lifted as DMLL
@@ -68,6 +71,7 @@
 import qualified Data.Dependent.Map.Lifted.Lifted as DPMLL
 import qualified Data.Dependent.Map.Unboxed.Lifted as DPMUL
 import qualified Data.Map.Subset.Strict.Lifted as MSL
+import qualified Data.Map.Interval.DBTSLL as MIDBTS
 
 main :: IO ()
 main = defaultMain $ testGroup "Data"
@@ -75,16 +79,20 @@
     [ testGroup "Unboxed"
       [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (SU.Set Int16)))
       , lawsToTest (QCC.ordLaws (Proxy :: Proxy (SU.Set Int16)))
+      , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (SU.Set Int16)))
       , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (SU.Set Int16)))
       , lawsToTest (QCC.isListLaws (Proxy :: Proxy (SU.Set Int16)))
       , TQC.testProperty "member" (memberProp @Int16 E.fromList SU.member)
+      , TQC.testProperty "tripleton" setTripletonProp
       ]
     , testGroup "Lifted"
       [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (SL.Set Integer)))
       , lawsToTest (QCC.ordLaws (Proxy :: Proxy (SL.Set Integer)))
+      , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (SL.Set Integer)))
       , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (SL.Set Integer)))
       , lawsToTest (QCC.isListLaws (Proxy :: Proxy (SL.Set Integer)))
       , TQC.testProperty "member" (memberProp @Integer E.fromList SL.member)
+      , TQC.testProperty "nonMember" (nonMemberProp E.fromList SL.member)
       , TQC.testProperty "foldr" (QCCL.foldrProp int32 SL.foldr)
       , TQC.testProperty "foldl'" (QCCL.foldlProp int16 SL.foldl')
       , TQC.testProperty "foldr'" (QCCL.foldrProp int32 SL.foldr')
@@ -98,6 +106,7 @@
     , testGroup "Unlifted"
       [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (SUL.Set (PrimArray Int16))))
       , lawsToTest (QCC.ordLaws (Proxy :: Proxy (SUL.Set (PrimArray Int16))))
+      , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (SUL.Set (PrimArray Int16))))
       , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (SUL.Set (PrimArray Int16))))
       , lawsToTest (QCC.isListLaws (Proxy :: Proxy (SUL.Set (PrimArray Int16))))
       , TQC.testProperty "member" (memberProp @(PrimArray Int16) E.fromList SUL.member)
@@ -109,6 +118,7 @@
         [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (MUU.Map Word32 Int)))
         , lawsToTest (QCC.ordLaws (Proxy :: Proxy (MUU.Map Word32 Int)))
         , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (MUU.Map Word32 Word)))
+        , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (MUU.Map Word32 Int)))
         , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (MUU.Map Word32 Int)))
         , lawsToTest (QCC.isListLaws (Proxy :: Proxy (MUU.Map Word32 Int)))
         , TQC.testProperty "lookup" (lookupProp @Word32 @Int E.fromList MUU.lookup)
@@ -117,23 +127,77 @@
         , TQC.testProperty "foldMapWithKey'" (mapFoldMonoidAgreement MUU.foldMapWithKey' M.foldMapWithKey)
         , TQC.testProperty "mapMaybe" mapMaybeProp
         ]
+      , testGroup "Lifted"
+        [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , lawsToTest (QCC.ordLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , lawsToTest (QCC.isListLaws (Proxy :: Proxy (MUL.Map Word32 Integer)))
+        , TQC.testProperty "lookup-empty" lookupEmptyUnboxedLiftedMapProp
+        , TQC.testProperty "mapWithKey" mapWithKeyProp
+        , TQC.testProperty "appendWithKey" appendWithKeyUnboxedLiftedProp
+        ]
       ]
-    ]
-  , testGroup "Dependent"
-    [ testGroup "Map"
+    , testGroup "Lifted"
       [ testGroup "Lifted"
-        [ testGroup "Lifted"
-          [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
-          , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
-          , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , lawsToTest (QCC.ordLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , lawsToTest (QCC.isListLaws (Proxy :: Proxy (MLL.Map Integer Integer)))
+        , TQC.testProperty "appendWithKey" appendWithKeyLiftedLiftedProp
+        ]
+      ]
+    , testGroup "Interval"
+      [ testGroup "DBTS"
+        [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (MIDBTS.Map Word8 Integer)))
+        , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (MIDBTS.Map Word8 (S.Set Integer))))
+        , lawsToTest (QCC.commutativeSemigroupLaws (Proxy :: Proxy (MIDBTS.Map Word8 (S.Set Integer))))
+        , lawsToTest (QCC.idempotentSemigroupLaws (Proxy :: Proxy (MIDBTS.Map Word8 (S.Set Integer))))
+        , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (MIDBTS.Map Word8 Integer)))
+        , lawsToTest (QCC.isListLaws (Proxy :: Proxy (MIDBTS.Map Word8 Integer)))
+        , TQC.testProperty "lookup" dbtsIntervalMapLookupProp
+        , testGroup "Unit"
+          [ testCase "A" $ do
+              let s = MIDBTS.singleton 102 (1 :: Word8) (2 :: Word8) (101 :: Integer)
+              show s @?= "fromList [(0,0,102),(1,2,101),(3,255,102)]"
+          , testCase "B" $ do
+              let s = MIDBTS.singleton 102 (2 :: Word8) (2 :: Word8) (101 :: Integer)
+              show s @?= "fromList [(0,1,102),(2,2,101),(3,255,102)]"
+          , testCase "C" $ do
+              let s = MIDBTS.singleton 102 (0 :: Word8) (0 :: Word8) (101 :: Integer)
+              show s @?= "fromList [(0,0,101),(1,255,102)]"
+          , testCase "D" $ do
+              let s = MIDBTS.fromList 102 [(1 :: Word8, 2 :: Word8, 100 :: Integer),(5,7,101)]
+              show s @?= "fromList [(0,0,102),(1,2,100),(3,4,102),(5,7,101),(8,255,102)]"
+          , testCase "E" $ do
+              let s = MIDBTS.fromList 102 [(5,7,101),(1 :: Word8, 2 :: Word8, 100 :: Integer)]
+              show s @?= "fromList [(0,0,102),(1,2,100),(3,4,102),(5,7,101),(8,255,102)]"
           ]
         ]
-      , testGroup "Unboxed"
+      ]
+    ]
+  , testGroup "Dependent"
+    [ testGroup "Map"
+      [ -- testGroup "Lifted"
+        -- [ testGroup "Lifted"
+        --   [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        --   , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        --   , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        --   , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        --   , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DPMLL.Map Key Value)))
+        --   ]
+        -- ]
+        testGroup "Unboxed"
         [ testGroup "Lifted"
           [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
           , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
           , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
           , lawsToTest (QCC.jsonLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
+          , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
+          , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))
           ]
         ]
       ]
@@ -172,6 +236,7 @@
       [ testGroup "Set"
         [ testGroup "Lifted"
           [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DUSL.Set Word8)))
+          , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DUSL.Set Word8)))
           , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (DUSL.Set Word8)))
           ]
         ]
@@ -180,6 +245,7 @@
       [ testGroup "Lifted"
         [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DSL.Set Word16)))
         , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DSL.Set Word16)))
+        , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DSL.Set Word16)))
         , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (DSL.Set Word16)))
         , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DSL.Set Word16)))
         , TQC.testProperty "member" (dietMemberProp @Word8 E.fromList DSL.member)
@@ -204,6 +270,7 @@
         [ testGroup "Lifted"
           [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (MSL.Map Integer (SG.Sum Integer))))
           , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (MSL.Map Integer (SG.First Integer))))
+          , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (MSL.Map Integer (SG.Sum Integer))))
           , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (MSL.Map Integer (SG.Sum Integer))))
           , TQC.testProperty "lookup" subsetMapLookupProp
           ]
@@ -367,6 +434,26 @@
       func x = if even x then Just (x * x) else Nothing
    in MUU.toList (MUU.mapMaybe func xs') === M.toList (M.mapMaybe func xs)
 
+mapWithKeyProp :: QC.Property
+mapWithKeyProp = QC.property $ \(xs :: M.Map Word8 Word8) ->
+  let xs' = MUL.fromList (M.toList xs)
+      func x y = if even x then y * x else x + 1
+   in MUL.toList (MUL.mapWithKey func xs') === M.toList (M.mapWithKey func xs)
+
+appendWithKeyUnboxedLiftedProp :: QC.Property
+appendWithKeyUnboxedLiftedProp = QC.property $ \(xs :: M.Map Word8 Word8) ys ->
+  let xs' = MUL.fromList (M.toList xs)
+      ys' = MUL.fromList (M.toList ys) 
+      func k x y = k + 2 * x + 3 * y
+   in MUL.toList (MUL.appendWithKey func xs' ys') === M.toList (M.unionWithKey func xs ys)
+
+appendWithKeyLiftedLiftedProp :: QC.Property
+appendWithKeyLiftedLiftedProp = QC.property $ \(xs :: M.Map Word8 Word8) ys ->
+  let xs' = MLL.fromList (M.toList xs)
+      ys' = MLL.fromList (M.toList ys) 
+      func k x y = k + 2 * x + 3 * y
+   in MLL.toList (MLL.appendWithKey func xs' ys') === M.toList (M.unionWithKey func xs ys)
+
 itraverseSetProp :: QC.Property
 itraverseSetProp = QC.property $ \(xs :: S.Set Int) ->
   let xs' = SL.fromList (S.toList xs)
@@ -399,12 +486,31 @@
   let c = containerFromList xs
    in all (\x -> containerMember x c) xs === True
 
+setTripletonProp :: QC.Property
+setTripletonProp = QC.property $ \(a :: Int16) (b :: Int16) (c :: Int16) ->
+  SU.tripleton a b c === SU.fromList [a,b,c]
+
+nonMemberProp :: forall t. ([Integer] -> t Integer) -> (Integer -> t Integer -> Bool) -> QC.Property
+nonMemberProp containerFromList containerMember = QC.property $ \(xs :: [Integer]) ->
+  let c = containerFromList xs
+      upper = case xs of
+        [] -> 42
+        _ : _ -> maximum xs
+      lower = case xs of
+        [] -> (-42)
+        _ : _ -> minimum xs
+   in (containerMember (succ upper) c, containerMember (pred lower) c) === (False,False)
+
 lookupProp :: forall k v t. (Arbitrary k, Show k, Ord k, Arbitrary v, Show v, Eq v) => ([(k,v)] -> t k v) -> (k -> t k v -> Maybe v) -> QC.Property
 lookupProp containerFromList containerLookup = QC.property $ \(xs :: [(k,v)]) ->
   let ys = M.fromList xs
       c = containerFromList xs
    in all (\(x,_) -> containerLookup x c == M.lookup x ys) xs === True
 
+lookupEmptyUnboxedLiftedMapProp :: QC.Property
+lookupEmptyUnboxedLiftedMapProp = QC.property $ \(x :: Word16) ->
+  MUL.lookup x (MUL.empty :: MUL.Map Word16 Integer) === Nothing
+
 dietMemberProp :: forall a t. (Arbitrary a, Show a, Ord a, Arbitrary a, Show (t a)) => ([(a,a)] -> t a) -> (a -> t a -> Bool) -> QC.Property
 dietMemberProp containerFromList containerLookup = QC.property $ \(xs :: [a]) ->
   let c = containerFromList (map (\a -> (a,a)) xs)
@@ -416,6 +522,12 @@
       c = containerFromList (map (\(k,v) -> (k,k,v)) xs)
    in QC.counterexample ("original list: " ++ show xs ++ "; diet map: " ++ show c) (all (\(x,_) -> containerLookup x c == M.lookup x ys) xs === True)
 
+dbtsIntervalMapLookupProp :: QC.Property
+dbtsIntervalMapLookupProp = QC.property $ \(xs :: [(Word8,Word8,Integer)]) (k :: Word8) ->
+  let ys = MIDBTS.fromList Nothing (fmap (\(lo,hi,r) -> (lo,hi,Just r)) xs)
+      expected = fmap (\(_,_,r) -> r) (F.find (\(lo,hi,_) -> lo <= k && k <= hi) xs)
+   in expected === MIDBTS.lookup k ys
+
 dietDoubletonProp :: QC.Property
 dietDoubletonProp = QC.property $ \(loA :: Word8) (hiA :: Word8) (valA :: Int) (loB :: Word8) (hiB :: Word8) (valB :: Int) ->
   (hiA >= loA && hiB >= loB)
@@ -491,9 +603,18 @@
 instance (Arbitrary k, Prim k, Ord k, Arbitrary v, Prim v) => Arbitrary (MUU.Map k v) where
   arbitrary = fmap E.fromList QC.arbitrary
 
+instance (Arbitrary k, Prim k, Ord k, Arbitrary v) => Arbitrary (MUL.Map k v) where
+  arbitrary = fmap E.fromList QC.arbitrary
+
+instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (MLL.Map k v) where
+  arbitrary = fmap E.fromList QC.arbitrary
+
 instance (Arbitrary k, Ord k, Enum k, Bounded k, Arbitrary v, Semigroup v, Eq v) => Arbitrary (DMLL.Map k v) where
   arbitrary = DMLL.fromListAppend <$> QC.vectorOf 10 arbitraryOrderedPairValue
   shrink x = map E.fromList (QC.shrink (E.toList x))
+
+instance (Ord k, Enum k, Eq v, Bounded k, Arbitrary k, Arbitrary v) => Arbitrary (MIDBTS.Map k v) where
+  arbitrary = liftA2 MIDBTS.fromList QC.arbitrary (QC.vectorOf 10 arbitraryOrderedPairValue)
     
 instance (Arbitrary k, Ord k, Arbitrary v, Eq v, Semigroup v) => Arbitrary (MSL.Map k v) where
   arbitrary = do
@@ -613,7 +734,7 @@
 type instance Sing = SingUniverse
 
 type family Interpret (u :: Universe) :: Type where
-  Interpret 'UniverseInt = Int
+  Interpret 'UniverseInt = Integer
   Interpret 'UniverseOrdering = Ordering
   Interpret 'UniverseBool = Bool
   Interpret 'UniverseChar = Char
@@ -638,6 +759,12 @@
   showsPrecForeach SingUniverseBool p (Value x) = showsPrec p x
   showsPrecForeach SingUniverseOrdering p (Value x) = showsPrec p x
   showsPrecForeach SingUniverseChar p (Value x) = showsPrec p x
+
+instance SemigroupForeach Value where
+  appendForeach SingUniverseInt (Value x) (Value y) = Value (x + y)
+  appendForeach SingUniverseBool (Value x) (Value y) = Value (x && y)
+  appendForeach SingUniverseOrdering (Value x) (Value y) = Value (x <> y)
+  appendForeach SingUniverseChar (Value x) (Value _) = Value x
 
 -- This type interpret the lowest two bits of the Word8
 -- as the Universe value. Doing this is unsafe, but if the