diff --git a/Data/Graph.hs b/Data/Graph.hs
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -72,6 +72,7 @@
 import Data.Tree (Tree(Node), Forest)
 
 -- std interfaces
+import Control.Applicative
 import Control.DeepSeq (NFData(rnf))
 import Data.Maybe
 import Data.Array
@@ -93,6 +94,10 @@
     rnf (AcyclicSCC v) = rnf v
     rnf (CyclicSCC vs) = rnf vs
 
+instance Functor SCC where
+    fmap f (AcyclicSCC v) = AcyclicSCC (f v)
+    fmap f (CyclicSCC vs) = CyclicSCC (fmap f vs)
+
 -- | The vertices of a list of strongly connected components.
 flattenSCCs :: [SCC a] -> [a]
 flattenSCCs = concatMap flattenSCC
@@ -286,8 +291,23 @@
 
 instance Monad (SetM s) where
     return x     = SetM $ const (return x)
-    SetM v >>= f = SetM $ \ s -> do { x <- v s; runSetM (f x) s }
+    {-# INLINE return #-}
+    SetM v >>= f = SetM $ \s -> do { x <- v s; runSetM (f x) s }
+    {-# INLINE (>>=) #-}
 
+instance Functor (SetM s) where
+    f `fmap` SetM v = SetM $ \s -> f `fmap` v s
+    {-# INLINE fmap #-}
+
+instance Applicative (SetM s) where
+    pure x = SetM $ const (return x)
+    {-# INLINE pure #-}
+    SetM f <*> SetM v = SetM $ \s -> f s >>= (`fmap` v s)
+    -- We could also use the following definition
+    --   SetM f <*> SetM v = SetM $ \s -> f s <*> v s
+    -- but Applicative (ST s) instance is present only in GHC 7.2+
+    {-# INLINE (<*>) #-}
+
 run          :: Bounds -> (forall s. SetM s a) -> a
 run bnds act  = runST (newArray bnds False >>= runSetM act)
 
@@ -304,8 +324,18 @@
 newtype SetM s a = SetM { runSetM :: IntSet -> (a, IntSet) }
 
 instance Monad (SetM s) where
-    return x     = SetM $ \ s -> (x, s)
-    SetM v >>= f = SetM $ \ s -> case v s of (x, s') -> runSetM (f x) s'
+    return x     = SetM $ \s -> (x, s)
+    SetM v >>= f = SetM $ \s -> case v s of (x, s') -> runSetM (f x) s'
+
+instance Functor (SetM s) where
+    f `fmap` SetM v = SetM $ \s -> case v s of (x, s') -> (f x, s')
+    {-# INLINE fmap #-}
+
+instance Applicative (SetM s) where
+    pure x = SetM $ \s -> (x, s)
+    {-# INLINE pure #-}
+    SetM f <*> SetM v = SetM $ \s -> case f s of (k, s') -> case v s' of (x, s'') -> (k x, s'')
+    {-# INLINE (<*>) #-}
 
 run          :: Bounds -> SetM s a -> a
 run _ act     = fst (runSetM act Set.empty)
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -165,6 +165,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
@@ -196,7 +197,7 @@
     -- * Utility
     , natFromInt
     , intFromNat
-    , join
+    , link
     , bin
     , zero
     , nomatch
@@ -572,12 +573,12 @@
 insert k x t = k `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> join k (Tip k x) p t
+      | nomatch k p m -> link k (Tip k x) p t
       | zero k m      -> Bin p m (insert k x l) r
       | otherwise     -> Bin p m l (insert k x r)
     Tip ky _
       | k==ky         -> Tip k x
-      | otherwise     -> join k (Tip k x) ky t
+      | otherwise     -> link k (Tip k x) ky t
     Nil -> Tip k x
 
 -- right-biased insertion, used by 'union'
@@ -610,12 +611,12 @@
 insertWithKey f k x t = k `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> join k (Tip k x) p t
+      | nomatch k p m -> link k (Tip k x) p t
       | zero k m      -> Bin p m (insertWithKey f k x l) r
       | otherwise     -> Bin p m l (insertWithKey f k x r)
     Tip ky y
       | k==ky         -> Tip k (f k x y)
-      | otherwise     -> join k (Tip k x) ky t
+      | otherwise     -> link k (Tip k x) ky t
     Nil -> Tip k x
 
 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
@@ -637,12 +638,12 @@
 insertLookupWithKey f k x t = k `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> (Nothing,join k (Tip k x) p t)
+      | nomatch k p m -> (Nothing,link k (Tip k x) p t)
       | zero k m      -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
       | otherwise     -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
     Tip ky y
       | k==ky         -> (Just y,Tip k (f k x y))
-      | otherwise     -> (Nothing,join k (Tip k x) ky t)
+      | otherwise     -> (Nothing,link k (Tip k x) ky t)
     Nil -> (Nothing,Tip k x)
 
 
@@ -762,7 +763,7 @@
     Bin p m l r
       | nomatch k p m -> case f Nothing of
                            Nothing -> t
-                           Just x -> join k (Tip k x) p t
+                           Just x -> link k (Tip k x) p t
       | zero k m      -> bin p m (alter f k l) r
       | otherwise     -> bin p m l (alter f k r)
     Tip ky y
@@ -770,7 +771,7 @@
                            Just x -> Tip ky x
                            Nothing -> Nil
       | otherwise     -> case f Nothing of
-                           Just x -> join k (Tip k x) ky t
+                           Just x -> link k (Tip k x) ky t
                            Nothing -> Tip ky y
     Nil               -> case f Nothing of
                            Just x -> Tip k x
@@ -956,39 +957,39 @@
       | shorter m1 m2  = merge1
       | shorter m2 m1  = merge2
       | p1 == p2       = bin' p1 m1 (go l1 l2) (go r1 r2)
-      | otherwise      = maybe_join p1 (g1 t1) p2 (g2 t2)
+      | otherwise      = maybe_link p1 (g1 t1) p2 (g2 t2)
       where
-        merge1 | nomatch p2 p1 m1  = maybe_join p1 (g1 t1) p2 (g2 t2)
+        merge1 | nomatch p2 p1 m1  = maybe_link p1 (g1 t1) p2 (g2 t2)
                | zero p2 m1        = bin' p1 m1 (go l1 t2) (g1 r1)
                | otherwise         = bin' p1 m1 (g1 l1) (go r1 t2)
-        merge2 | nomatch p1 p2 m2  = maybe_join p1 (g1 t1) p2 (g2 t2)
+        merge2 | nomatch p1 p2 m2  = maybe_link p1 (g1 t1) p2 (g2 t2)
                | zero p1 m2        = bin' p2 m2 (go t1 l2) (g2 r2)
                | otherwise         = bin' p2 m2 (g2 l2) (go t1 r2)
 
     go t1'@(Bin _ _ _ _) t2'@(Tip k2' _) = merge t2' k2' t1'
-      where merge t2 k2 t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = maybe_join p1 (g1 t1) k2 (g2 t2)
+      where merge t2 k2 t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = maybe_link p1 (g1 t1) k2 (g2 t2)
                                              | zero k2 m1 = bin' p1 m1 (merge t2 k2 l1) (g1 r1)
                                              | otherwise  = bin' p1 m1 (g1 l1) (merge t2 k2 r1)
             merge t2 k2 t1@(Tip k1 _) | k1 == k2 = f t1 t2
-                                      | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+                                      | otherwise = maybe_link k1 (g1 t1) k2 (g2 t2)
             merge t2 _  Nil = g2 t2
 
     go t1@(Bin _ _ _ _) Nil = g1 t1
 
     go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
-      where merge t1 k1 t2@(Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = maybe_join k1 (g1 t1) p2 (g2 t2)
+      where merge t1 k1 t2@(Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = maybe_link k1 (g1 t1) p2 (g2 t2)
                                              | zero k1 m2 = bin' p2 m2 (merge t1 k1 l2) (g2 r2)
                                              | otherwise  = bin' p2 m2 (g2 l2) (merge t1 k1 r2)
             merge t1 k1 t2@(Tip k2 _) | k1 == k2 = f t1 t2
-                                      | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+                                      | otherwise = maybe_link k1 (g1 t1) k2 (g2 t2)
             merge t1 _  Nil = g1 t1
 
     go Nil t2 = g2 t2
 
-    maybe_join _ Nil _ t2 = t2
-    maybe_join _ t1 _ Nil = t1
-    maybe_join p1 t1 p2 t2 = join p1 t1 p2 t2
-    {-# INLINE maybe_join #-}
+    maybe_link _ Nil _ t2 = t2
+    maybe_link _ t1 _ Nil = t1
+    maybe_link p1 t1 p2 t2 = link p1 t1 p2 t2
+    {-# INLINE maybe_link #-}
 {-# INLINE mergeWithKey' #-}
 
 {--------------------------------------------------------------------
@@ -1923,7 +1924,7 @@
                  else work z zs (Push px tx stk)
 
     finish _  t  Nada = t
-    finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+    finish px tx (Push py ty stk) = finish p (link py ty px tx) stk
         where m = branchMask px py
               p = mask px m
 
@@ -2004,16 +2005,16 @@
   Helpers
 --------------------------------------------------------------------}
 {--------------------------------------------------------------------
-  Join
+  Link
 --------------------------------------------------------------------}
-join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
-join p1 t1 p2 t2
+link :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
+link p1 t1 p2 t2
   | zero p1 m = Bin p m t1 t2
   | otherwise = Bin p m t2 t1
   where
     m = branchMask p1 p2
     p = mask p1 m
-{-# INLINE join #-}
+{-# INLINE link #-}
 
 {--------------------------------------------------------------------
   @bin@ assures that we never have empty trees within a tree.
@@ -2076,6 +2077,34 @@
     go z []     = z
     go z (x:xs) = let z' = f z x in z' `seq` go z' xs
 {-# INLINE foldlStrict #-}
+
+-- | /O(1)/.  Decompose a map into pieces based on the structure of the underlying
+-- tree.  This function is useful for consuming a map in parallel.
+--
+-- No guarantee is made as to the sizes of the pieces; an internal, but
+-- deterministic process determines this.  However, it is guaranteed that the
+-- pieces returned will be in ascending order (all elements in the first submap
+-- less than all elements in the second, and so on).
+--
+-- Examples:
+--
+-- > splitRoot (fromList (zip [1..6::Int] ['a'..])) ==
+-- >   [fromList [(1,'a'),(2,'b'),(3,'c')],fromList [(4,'d'),(5,'e'),(6,'f')]]
+--
+-- > splitRoot empty == []
+--
+--  Note that the current implementation does not return more than two submaps,
+--  but you should not depend on this behaviour because it can change in the
+--  future without notice.
+splitRoot :: IntMap a -> [IntMap a]
+splitRoot orig =
+  case orig of
+    Nil -> []
+    x@(Tip _ _) -> [x]
+    Bin _ m l r | m < 0 -> [r, l]
+                | otherwise -> [l, r]
+{-# INLINE splitRoot #-}
+
 
 {--------------------------------------------------------------------
   Debugging
diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs
--- a/Data/IntMap/Lazy.hs
+++ b/Data/IntMap/Lazy.hs
@@ -175,6 +175,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -181,6 +181,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
@@ -328,12 +329,12 @@
 insert k x t = k `seq` x `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> join k (Tip k x) p t
+      | nomatch k p m -> link k (Tip k x) p t
       | zero k m      -> Bin p m (insert k x l) r
       | otherwise     -> Bin p m l (insert k x r)
     Tip ky _
       | k==ky         -> Tip k x
-      | otherwise     -> join k (Tip k x) ky t
+      | otherwise     -> link k (Tip k x) ky t
     Nil -> Tip k x
 
 -- right-biased insertion, used by 'union'
@@ -369,12 +370,12 @@
 insertWithKey f k x t = k `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> join k (singleton k x) p t
+      | nomatch k p m -> link k (singleton k x) p t
       | zero k m      -> Bin p m (insertWithKey f k x l) r
       | otherwise     -> Bin p m l (insertWithKey f k x r)
     Tip ky y
       | k==ky         -> Tip k $! f k x y
-      | otherwise     -> join k (singleton k x) ky t
+      | otherwise     -> link k (singleton k x) ky t
     Nil -> singleton k x
 
 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
@@ -398,12 +399,12 @@
     go f k x t =
       case t of
         Bin p m l r
-          | nomatch k p m -> Nothing :*: join k (singleton k x) p t
+          | nomatch k p m -> Nothing :*: link k (singleton k x) p t
           | zero k m      -> let (found :*: l') = go f k x l in (found :*: Bin p m l' r)
           | otherwise     -> let (found :*: r') = go f k x r in (found :*: Bin p m l r')
         Tip ky y
           | k==ky         -> (Just y :*: (Tip k $! f k x y))
-          | otherwise     -> (Nothing :*: join k (singleton k x) ky t)
+          | otherwise     -> (Nothing :*: link k (singleton k x) ky t)
         Nil -> Nothing :*: (singleton k x)
 
 
@@ -506,7 +507,7 @@
     Bin p m l r
       | nomatch k p m -> case f Nothing of
                            Nothing -> t
-                           Just x  -> x `seq` join k (Tip k x) p t
+                           Just x  -> x `seq` link k (Tip k x) p t
       | zero k m      -> bin p m (alter f k l) r
       | otherwise     -> bin p m l (alter f k r)
     Tip ky y
@@ -514,7 +515,7 @@
                            Just  x -> x `seq` Tip ky x
                            Nothing -> Nil
       | otherwise     -> case f Nothing of
-                           Just x  -> x `seq` join k (Tip k x) ky t
+                           Just x  -> x `seq` link k (Tip k x) ky t
                            Nothing -> t
     Nil               -> case f Nothing of
                            Just x  -> x `seq` Tip k x
@@ -970,7 +971,7 @@
                  else work z zs (Push px tx stk)
 
     finish _  t  Nada = t
-    finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+    finish px tx (Push py ty stk) = finish p (link py ty px tx) stk
         where m = branchMask px py
               p = mask px m
 
diff --git a/Data/IntSet.hs b/Data/IntSet.hs
--- a/Data/IntSet.hs
+++ b/Data/IntSet.hs
@@ -90,6 +90,7 @@
             , partition
             , split
             , splitMember
+            , splitRoot
 
             -- * Map
             , IS.map
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -111,6 +111,7 @@
     , partition
     , split
     , splitMember
+    , splitRoot
 
     -- * Map
     , map
@@ -158,6 +159,26 @@
     , bitmapOf
     ) where
 
+-- We want to be able to compile without cabal. Nevertheless
+-- #if defined(MIN_VERSION_base) && MIN_VERSION_base(4,5,0)
+-- does not work, because if MIN_VERSION_base is undefined,
+-- the last condition is syntactically wrong.
+#define MIN_VERSION_base_4_5_0 0
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,5,0)
+#undef MIN_VERSION_base_4_5_0
+#define MIN_VERSION_base_4_5_0 1
+#endif
+#endif
+
+#define MIN_VERSION_base_4_7_0 0
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,7,0)
+#undef MIN_VERSION_base_4_7_0
+#define MIN_VERSION_base_4_7_0 1
+#endif
+#endif
+
 import Control.DeepSeq (NFData)
 import Data.Bits
 import qualified Data.List as List
@@ -438,12 +459,12 @@
 insertBM kx bm t = kx `seq` bm `seq`
   case t of
     Bin p m l r
-      | nomatch kx p m -> join kx (Tip kx bm) p t
+      | nomatch kx p m -> link kx (Tip kx bm) p t
       | zero kx m      -> Bin p m (insertBM kx bm l) r
       | otherwise      -> Bin p m l (insertBM kx bm r)
     Tip kx' bm'
       | kx' == kx -> Tip kx' (bm .|. bm')
-      | otherwise -> join kx (Tip kx bm) kx' t
+      | otherwise -> link kx (Tip kx bm) kx' t
     Nil -> Tip kx bm
 
 -- | /O(min(n,W))/. Delete a value in the set. Returns the
@@ -481,13 +502,13 @@
   | shorter m1 m2  = union1
   | shorter m2 m1  = union2
   | p1 == p2       = Bin p1 m1 (union l1 l2) (union r1 r2)
-  | otherwise      = join p1 t1 p2 t2
+  | otherwise      = link p1 t1 p2 t2
   where
-    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
+    union1  | nomatch p2 p1 m1  = link p1 t1 p2 t2
             | zero p2 m1        = Bin p1 m1 (union l1 t2) r1
             | otherwise         = Bin p1 m1 l1 (union r1 t2)
 
-    union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
+    union2  | nomatch p1 p2 m2  = link p1 t1 p2 t2
             | zero p1 m2        = Bin p2 m2 (union t1 l2) r2
             | otherwise         = Bin p2 m2 l2 (union t1 r2)
 
@@ -999,7 +1020,7 @@
                  else work (prefixOf z) (bitmapOf z) zs (Push px tx stk)
 
     finish _  t  Nada = t
-    finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+    finish px tx (Push py ty stk) = finish p (link py ty px tx) stk
         where m = branchMask px py
               p = mask px m
 
@@ -1159,16 +1180,16 @@
   Helpers
 --------------------------------------------------------------------}
 {--------------------------------------------------------------------
-  Join
+  Link
 --------------------------------------------------------------------}
-join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
-join p1 t1 p2 t2
+link :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
+link p1 t1 p2 t2
   | zero p1 m = Bin p m t1 t2
   | otherwise = Bin p m t2 t1
   where
     m = branchMask p1 p2
     p = mask p1 m
-{-# INLINE join #-}
+{-# INLINE link #-}
 
 {--------------------------------------------------------------------
   @bin@ assures that we never have empty trees within a tree.
@@ -1193,7 +1214,11 @@
 ----------------------------------------------------------------------}
 
 suffixBitMask :: Int
+#if MIN_VERSION_base_4_7_0
+suffixBitMask = finiteBitSize (undefined::Word) - 1
+#else
 suffixBitMask = bitSize (undefined::Word) - 1
+#endif
 {-# INLINE suffixBitMask #-}
 
 prefixBitMask :: Int
@@ -1439,18 +1464,6 @@
     Derrick Lehmer and published in 1964 in a book edited by Beckenbach.)"
 ----------------------------------------------------------------------}
 
--- We want to be able to compile without cabal. Nevertheless
--- #if defined(MIN_VERSION_base) && MIN_VERSION_base(4,5,0)
--- does not work, because if MIN_VERSION_base is undefined,
--- the last condition is syntactically wrong.
-#define MIN_VERSION_base_4_5_0 0
-#ifdef MIN_VERSION_base
-#if MIN_VERSION_base(4,5,0)
-#undef MIN_VERSION_base_4_5_0
-#define MIN_VERSION_base_4_5_0 1
-#endif
-#endif
-
 bitcount :: Int -> Word -> Int
 #if MIN_VERSION_base_4_5_0
 bitcount a x = a + popCount x
@@ -1471,3 +1484,31 @@
     go z []     = z
     go z (x:xs) = let z' = f z x in z' `seq` go z' xs
 {-# INLINE foldlStrict #-}
+
+-- | /O(1)/.  Decompose a set into pieces based on the structure of the underlying
+-- tree.  This function is useful for consuming a set in parallel.
+--
+-- No guarantee is made as to the sizes of the pieces; an internal, but
+-- deterministic process determines this.  However, it is guaranteed that the
+-- pieces returned will be in ascending order (all elements in the first submap
+-- less than all elements in the second, and so on).
+--
+-- Examples:
+--
+-- > splitRoot (fromList [1..120]) == [fromList [1..63],fromList [64..120]]
+-- > splitRoot empty == []
+--
+--  Note that the current implementation does not return more than two subsets,
+--  but you should not depend on this behaviour because it can change in the
+--  future without notice. Also, the current version does not continue
+--  splitting all the way to individual singleton sets -- it stops at some
+--  point.
+splitRoot :: IntSet -> [IntSet]
+splitRoot orig =
+  case orig of
+    Nil -> []
+    -- NOTE: we don't currently split below Tip, but we could.
+    x@(Tip _ _) -> [x]
+    Bin _ m l r | m < 0 -> [r, l]
+                | otherwise -> [l, r]
+{-# INLINE splitRoot #-}
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -211,6 +211,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
@@ -251,7 +252,7 @@
     , balanceL
     , balanceR
     , delta
-    , join
+    , link
     , insertMax
     , merge
     , glue
@@ -1221,10 +1222,10 @@
 -- left-biased hedge union
 hedgeUnion :: Ord a => MaybeS a -> MaybeS a -> Map a b -> Map a b -> Map a b
 hedgeUnion _   _   t1  Tip = t1
-hedgeUnion blo bhi Tip (Bin _ kx x l r) = join kx x (filterGt blo l) (filterLt bhi r)
+hedgeUnion blo bhi Tip (Bin _ kx x l r) = link kx x (filterGt blo l) (filterLt bhi r)
 hedgeUnion _   _   t1  (Bin _ kx x Tip Tip) = insertR kx x t1  -- According to benchmarks, this special case increases
                                                               -- performance up to 30%. It does not help in difference or intersection.
-hedgeUnion blo bhi (Bin _ kx x l r) t2 = join kx x (hedgeUnion blo bmi l (trim blo bmi t2))
+hedgeUnion blo bhi (Bin _ kx x l r) t2 = link kx x (hedgeUnion blo bmi l (trim blo bmi t2))
                                                    (hedgeUnion bmi bhi r (trim bmi bhi t2))
   where bmi = JustS kx
 #if __GLASGOW_HASKELL__ >= 700
@@ -1276,7 +1277,7 @@
 
 hedgeDiff :: Ord a => MaybeS a -> MaybeS a -> Map a b -> Map a c -> Map a b
 hedgeDiff _   _   Tip              _ = Tip
-hedgeDiff blo bhi (Bin _ kx x l r) Tip = join kx x (filterGt blo l) (filterLt bhi r)
+hedgeDiff blo bhi (Bin _ kx x l r) Tip = link kx x (filterGt blo l) (filterLt bhi r)
 hedgeDiff blo bhi t (Bin _ kx _ l r) = merge (hedgeDiff blo bmi (trim blo bmi t) l)
                                              (hedgeDiff bmi bhi (trim bmi bhi t) r)
   where bmi = JustS kx
@@ -1343,7 +1344,7 @@
 hedgeInt _ _ Tip _   = Tip
 hedgeInt blo bhi (Bin _ kx x l r) t2 = let l' = hedgeInt blo bmi l (trim blo bmi t2)
                                            r' = hedgeInt bmi bhi r (trim bmi bhi t2)
-                                       in if kx `member` t2 then join kx x l' r' else merge l' r'
+                                       in if kx `member` t2 then link kx x l' r' else merge l' r'
   where bmi = JustS kx
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE hedgeInt #-}
@@ -1424,18 +1425,18 @@
     go t1 t2 = hedgeMerge NothingS NothingS t1 t2
 
     hedgeMerge _   _   t1  Tip = g1 t1
-    hedgeMerge blo bhi Tip (Bin _ kx x l r) = g2 $ join kx x (filterGt blo l) (filterLt bhi r)
+    hedgeMerge blo bhi Tip (Bin _ kx x l r) = g2 $ link kx x (filterGt blo l) (filterLt bhi r)
     hedgeMerge blo bhi (Bin _ kx x l r) t2 = let l' = hedgeMerge blo bmi l (trim blo bmi t2)
                                                  (found, trim_t2) = trimLookupLo kx bhi t2
                                                  r' = hedgeMerge bmi bhi r trim_t2
                                              in case found of
                                                   Nothing -> case g1 (singleton kx x) of
                                                                Tip -> merge l' r'
-                                                               (Bin _ _ x' Tip Tip) -> join kx x' l' r'
+                                                               (Bin _ _ x' Tip Tip) -> link kx x' l' r'
                                                                _ -> error "mergeWithKey: Given function only1 does not fulfil required conditions (see documentation)"
                                                   Just x2 -> case f kx x x2 of
                                                                Nothing -> merge l' r'
-                                                               Just x' -> join kx x' l' r'
+                                                               Just x' -> link kx x' l' r'
       where bmi = JustS kx
 {-# INLINE mergeWithKey #-}
 
@@ -1543,7 +1544,7 @@
 filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a
 filterWithKey _ Tip = Tip
 filterWithKey p (Bin _ kx x l r)
-  | p kx x    = join kx x (filterWithKey p l) (filterWithKey p r)
+  | p kx x    = link kx x (filterWithKey p l) (filterWithKey p r)
   | otherwise = merge (filterWithKey p l) (filterWithKey p r)
 
 -- | /O(n)/. Partition the map according to a predicate. The first
@@ -1571,8 +1572,8 @@
   where
     go _ Tip = (Tip :*: Tip)
     go p (Bin _ kx x l r)
-      | p kx x    = join kx x l1 r1 :*: merge l2 r2
-      | otherwise = merge l1 r1 :*: join kx x l2 r2
+      | p kx x    = link kx x l1 r1 :*: merge l2 r2
+      | otherwise = merge l1 r1 :*: link kx x l2 r2
       where
         (l1 :*: l2) = go p l
         (r1 :*: r2) = go p r
@@ -1593,7 +1594,7 @@
 mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
 mapMaybeWithKey _ Tip = Tip
 mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
-  Just y  -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+  Just y  -> link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
   Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
 
 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
@@ -1623,8 +1624,8 @@
   where
     go _ Tip = (Tip :*: Tip)
     go f (Bin _ kx x l r) = case f kx x of
-      Left y  -> join kx y l1 r1 :*: merge l2 r2
-      Right z -> merge l1 r1 :*: join kx z l2 r2
+      Left y  -> link kx y l1 r1 :*: merge l2 r2
+      Right z -> merge l1 r1 :*: link kx z l2 r2
      where
         (l1 :*: l2) = go f l
         (r1 :*: r2) = go f r
@@ -1974,8 +1975,8 @@
     go _ t [(kx, x)] = insertMax kx x t
     go s l xs@((kx, x) : xss) | not_ordered kx xss = fromList' l xs
                               | otherwise = case create s xss of
-                                  (r, ys, []) -> go (s `shiftL` 1) (join kx x l r) ys
-                                  (r, _,  ys) -> fromList' (join kx x l r) ys
+                                  (r, ys, []) -> go (s `shiftL` 1) (link kx x l r) ys
+                                  (r, _,  ys) -> fromList' (link kx x l r) ys
 
     -- The create is returning a triple (tree, xs, ys). Both xs and ys
     -- represent not yet processed elements and only one of them can be nonempty.
@@ -1992,7 +1993,7 @@
                       (l, [(ky, y)], zs) -> (insertMax ky y l, [], zs)
                       (l, ys@((ky, y):yss), _) | not_ordered ky yss -> (l, [], ys)
                                                | otherwise -> case create (s `shiftR` 1) yss of
-                                                   (r, zs, ws) -> (join ky y l r, zs, ws)
+                                                   (r, zs, ws) -> (link ky y l r, zs, ws)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE fromList #-}
 #endif
@@ -2164,7 +2165,7 @@
     STRICT_1_OF_3(go)
     go _ t [] = t
     go s l ((kx, x) : xs) = case create s xs of
-                              (r, ys) -> go (s `shiftL` 1) (join kx x l r) ys
+                              (r, ys) -> go (s `shiftL` 1) (link kx x l r) ys
 
     STRICT_1_OF_2(create)
     create _ [] = (Tip, [])
@@ -2173,7 +2174,7 @@
       | otherwise = case create (s `shiftR` 1) xs of
                       res@(_, []) -> res
                       (l, (ky, y):ys) -> case create (s `shiftR` 1) ys of
-                        (r, zs) -> (join ky y l r, zs)
+                        (r, zs) -> (link ky y l r, zs)
 
 
 {--------------------------------------------------------------------
@@ -2254,7 +2255,7 @@
 filterGt (JustS b) t = filter' b t
   where filter' _   Tip = Tip
         filter' b' (Bin _ kx x l r) =
-          case compare b' kx of LT -> join kx x (filter' b' l) r
+          case compare b' kx of LT -> link kx x (filter' b' l) r
                                 EQ -> r
                                 GT -> filter' b' r
 #if __GLASGOW_HASKELL__ >= 700
@@ -2266,7 +2267,7 @@
 filterLt (JustS b) t = filter' b t
   where filter' _   Tip = Tip
         filter' b' (Bin _ kx x l r) =
-          case compare kx b' of LT -> join kx x l (filter' b' r)
+          case compare kx b' of LT -> link kx x l (filter' b' r)
                                 EQ -> l
                                 GT -> filter' b' l
 #if __GLASGOW_HASKELL__ >= 700
@@ -2293,8 +2294,8 @@
       case t of
         Tip            -> (Tip :*: Tip)
         Bin _ kx x l r -> case compare k kx of
-          LT -> let (lt :*: gt) = go k l in lt :*: join kx x gt r
-          GT -> let (lt :*: gt) = go k r in join kx x l lt :*: gt
+          LT -> let (lt :*: gt) = go k l in lt :*: link kx x gt r
+          GT -> let (lt :*: gt) = go k r in link kx x l lt :*: gt
           EQ -> (l :*: r)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE split #-}
@@ -2315,10 +2316,10 @@
     Tip            -> (Tip,Nothing,Tip)
     Bin _ kx x l r -> case compare k kx of
       LT -> let (lt,z,gt) = splitLookup k l
-                gt' = join kx x gt r
+                gt' = link kx x gt r
             in gt' `seq` (lt,z,gt')
       GT -> let (lt,z,gt) = splitLookup k r
-                lt' = join kx x l lt
+                lt' = link kx x l lt
             in lt' `seq` (lt',z,gt)
       EQ -> (l,Just x,r)
 #if __GLASGOW_HASKELL__ >= 700
@@ -2337,7 +2338,7 @@
     [balance k x l r] Restores the balance and size.
                       Assumes that the original tree was balanced and
                       that [l] or [r] has changed by at most one element.
-    [join k x l r]    Restores balance and size.
+    [link k x l r]    Restores balance and size.
 
   Furthermore, we can construct a new tree from two trees. Both operations
   assume that all values in [l] < all values in [r] and that [l] and [r]
@@ -2347,7 +2348,7 @@
     [merge l r]       Merges two trees and restores balance.
 
   Note: in contrast to Adam's paper, we use (<=) comparisons instead
-  of (<) comparisons in [join], [merge] and [balance].
+  of (<) comparisons in [link], [merge] and [balance].
   Quickcheck (on [difference]) showed that this was necessary in order
   to maintain the invariants. It is quite unsatisfactory that I haven't
   been able to find out why this is actually the case! Fortunately, it
@@ -2355,14 +2356,14 @@
 --------------------------------------------------------------------}
 
 {--------------------------------------------------------------------
-  Join
+  Link
 --------------------------------------------------------------------}
-join :: k -> a -> Map k a -> Map k a -> Map k a
-join kx x Tip r  = insertMin kx x r
-join kx x l Tip  = insertMax kx x l
-join kx x l@(Bin sizeL ky y ly ry) r@(Bin sizeR kz z lz rz)
-  | delta*sizeL < sizeR  = balanceL kz z (join kx x l lz) rz
-  | delta*sizeR < sizeL  = balanceR ky y ly (join kx x ry r)
+link :: k -> a -> Map k a -> Map k a -> Map k a
+link kx x Tip r  = insertMin kx x r
+link kx x l Tip  = insertMax kx x l
+link kx x l@(Bin sizeL ky y ly ry) r@(Bin sizeR kz z lz rz)
+  | delta*sizeL < sizeR  = balanceL kz z (link kx x l lz) rz
+  | delta*sizeR < sizeL  = balanceR ky y ly (link kx x ry r)
   | otherwise            = bin kx x l r
 
 
@@ -2813,3 +2814,29 @@
     go z []     = z
     go z (x:xs) = let z' = f z x in z' `seq` go z' xs
 {-# INLINE foldlStrict #-}
+
+
+-- | /O(1)/.  Decompose a map into pieces based on the structure of the underlying
+-- tree.  This function is useful for consuming a map in parallel.
+--
+-- No guarantee is made as to the sizes of the pieces; an internal, but
+-- deterministic process determines this.  However, it is guaranteed that the pieces
+-- returned will be in ascending order (all elements in the first submap less than all
+-- elements in the second, and so on).
+--
+-- Examples:
+--
+-- > splitRoot (fromList (zip [1..6] ['a'..])) ==
+-- >   [fromList [(1,'a'),(2,'b'),(3,'c')],fromList [(4,'d')],fromList [(5,'e'),(6,'f')]]
+--
+-- > splitRoot empty == []
+--
+--  Note that the current implementation does not return more than three submaps,
+--  but you should not depend on this behaviour because it can change in the
+--  future without notice.
+splitRoot :: Map k b -> [Map k b]
+splitRoot orig =
+  case orig of
+    Tip           -> []
+    Bin _ k v l r -> [l, singleton k v, r]
+{-# INLINE splitRoot #-}
diff --git a/Data/Map/Lazy.hs b/Data/Map/Lazy.hs
--- a/Data/Map/Lazy.hs
+++ b/Data/Map/Lazy.hs
@@ -171,6 +171,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
@@ -208,7 +209,7 @@
     -- * Internals
     , bin
     , balanced
-    , join
+    , link
     , merge
 #endif
 
diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs
--- a/Data/Map/Strict.hs
+++ b/Data/Map/Strict.hs
@@ -178,6 +178,7 @@
 
     , split
     , splitLookup
+    , splitRoot
 
     -- * Submap
     , isSubmapOf, isSubmapOfBy
@@ -215,7 +216,7 @@
     -- * Internals
     , bin
     , balanced
-    , join
+    , link
     , merge
 #endif
     ) where
@@ -842,18 +843,18 @@
     go t1 t2 = hedgeMerge NothingS NothingS t1 t2
 
     hedgeMerge _   _   t1  Tip = g1 t1
-    hedgeMerge blo bhi Tip (Bin _ kx x l r) = g2 $ join kx x (filterGt blo l) (filterLt bhi r)
+    hedgeMerge blo bhi Tip (Bin _ kx x l r) = g2 $ link kx x (filterGt blo l) (filterLt bhi r)
     hedgeMerge blo bhi (Bin _ kx x l r) t2 = let l' = hedgeMerge blo bmi l (trim blo bmi t2)
                                                  (found, trim_t2) = trimLookupLo kx bhi t2
                                                  r' = hedgeMerge bmi bhi r trim_t2
                                              in case found of
                                                   Nothing -> case g1 (singleton kx x) of
                                                                Tip -> merge l' r'
-                                                               (Bin _ _ x' Tip Tip) -> join kx x' l' r'
+                                                               (Bin _ _ x' Tip Tip) -> link kx x' l' r'
                                                                _ -> error "mergeWithKey: Given function only1 does not fulfil required conditions (see documentation)"
                                                   Just x2 -> case f kx x x2 of
                                                                Nothing -> merge l' r'
-                                                               Just x' -> x' `seq` join kx x' l' r'
+                                                               Just x' -> x' `seq` link kx x' l' r'
       where bmi = JustS kx
 {-# INLINE mergeWithKey #-}
 
@@ -877,7 +878,7 @@
 mapMaybeWithKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
 mapMaybeWithKey _ Tip = Tip
 mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
-  Just y  -> y `seq` join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+  Just y  -> y `seq` link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
   Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
 
 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
@@ -907,8 +908,8 @@
   where
     go _ Tip = (Tip :*: Tip)
     go f (Bin _ kx x l r) = case f kx x of
-      Left y  -> y `seq` (join kx y l1 r1 :*: merge l2 r2)
-      Right z -> z `seq` (merge l1 r1 :*: join kx z l2 r2)
+      Left y  -> y `seq` (link kx y l1 r1 :*: merge l2 r2)
+      Right z -> z `seq` (merge l1 r1 :*: link kx z l2 r2)
      where
         (l1 :*: l2) = go f l
         (r1 :*: r2) = go f r
@@ -1039,8 +1040,8 @@
     go _ t [(kx, x)] = x `seq` insertMax kx x t
     go s l xs@((kx, x) : xss) | not_ordered kx xss = fromList' l xs
                               | otherwise = case create s xss of
-                                  (r, ys, []) -> x `seq` go (s `shiftL` 1) (join kx x l r) ys
-                                  (r, _,  ys) -> x `seq` fromList' (join kx x l r) ys
+                                  (r, ys, []) -> x `seq` go (s `shiftL` 1) (link kx x l r) ys
+                                  (r, _,  ys) -> x `seq` fromList' (link kx x l r) ys
 
     -- The create is returning a triple (tree, xs, ys). Both xs and ys
     -- represent not yet processed elements and only one of them can be nonempty.
@@ -1057,7 +1058,7 @@
                       (l, [(ky, y)], zs) -> y `seq` (insertMax ky y l, [], zs)
                       (l, ys@((ky, y):yss), _) | not_ordered ky yss -> (l, [], ys)
                                                | otherwise -> case create (s `shiftR` 1) yss of
-                                                   (r, zs, ws) -> y `seq` (join ky y l r, zs, ws)
+                                                   (r, zs, ws) -> y `seq` (link ky y l r, zs, ws)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE fromList #-}
 #endif
@@ -1169,7 +1170,7 @@
     STRICT_1_OF_3(go)
     go _ t [] = t
     go s l ((kx, x) : xs) = case create s xs of
-                              (r, ys) -> x `seq` go (s `shiftL` 1) (join kx x l r) ys
+                              (r, ys) -> x `seq` go (s `shiftL` 1) (link kx x l r) ys
 
     STRICT_1_OF_2(create)
     create _ [] = (Tip, [])
@@ -1178,4 +1179,4 @@
       | otherwise = case create (s `shiftR` 1) xs of
                       res@(_, []) -> res
                       (l, (ky, y):ys) -> case create (s `shiftR` 1) ys of
-                        (r, zs) -> y `seq` (join ky y l r, zs)
+                        (r, zs) -> y `seq` (link ky y l r, zs)
diff --git a/Data/Set.hs b/Data/Set.hs
--- a/Data/Set.hs
+++ b/Data/Set.hs
@@ -80,6 +80,7 @@
             , partition
             , split
             , splitMember
+            , splitRoot
 
             -- * Indexed
             , lookupIndex
@@ -132,7 +133,7 @@
             -- Internals (for testing)
             , bin
             , balanced
-            , join
+            , link
             , merge
 #endif
             ) where
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -126,6 +126,7 @@
             , partition
             , split
             , splitMember
+            , splitRoot
 
             -- * Indexed
             , lookupIndex
@@ -177,7 +178,7 @@
             -- Internals (for testing)
             , bin
             , balanced
-            , join
+            , link
             , merge
             ) where
 
@@ -568,10 +569,10 @@
 
 hedgeUnion :: Ord a => MaybeS a -> MaybeS a -> Set a -> Set a -> Set a
 hedgeUnion _   _   t1  Tip = t1
-hedgeUnion blo bhi Tip (Bin _ x l r) = join x (filterGt blo l) (filterLt bhi r)
+hedgeUnion blo bhi Tip (Bin _ x l r) = link x (filterGt blo l) (filterLt bhi r)
 hedgeUnion _   _   t1  (Bin _ x Tip Tip) = insertR x t1   -- According to benchmarks, this special case increases
                                                           -- performance up to 30%. It does not help in difference or intersection.
-hedgeUnion blo bhi (Bin _ x l r) t2 = join x (hedgeUnion blo bmi l (trim blo bmi t2))
+hedgeUnion blo bhi (Bin _ x l r) t2 = link x (hedgeUnion blo bmi l (trim blo bmi t2))
                                              (hedgeUnion bmi bhi r (trim bmi bhi t2))
   where bmi = JustS x
 #if __GLASGOW_HASKELL__ >= 700
@@ -593,7 +594,7 @@
 
 hedgeDiff :: Ord a => MaybeS a -> MaybeS a -> Set a -> Set a -> Set a
 hedgeDiff _   _   Tip           _ = Tip
-hedgeDiff blo bhi (Bin _ x l r) Tip = join x (filterGt blo l) (filterLt bhi r)
+hedgeDiff blo bhi (Bin _ x l r) Tip = link x (filterGt blo l) (filterLt bhi r)
 hedgeDiff blo bhi t (Bin _ x l r) = merge (hedgeDiff blo bmi (trim blo bmi t) l)
                                           (hedgeDiff bmi bhi (trim bmi bhi t) r)
   where bmi = JustS x
@@ -629,7 +630,7 @@
 hedgeInt _ _ Tip _   = Tip
 hedgeInt blo bhi (Bin _ x l r) t2 = let l' = hedgeInt blo bmi l (trim blo bmi t2)
                                         r' = hedgeInt bmi bhi r (trim bmi bhi t2)
-                                    in if x `member` t2 then join x l' r' else merge l' r'
+                                    in if x `member` t2 then link x l' r' else merge l' r'
   where bmi = JustS x
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE hedgeInt #-}
@@ -642,7 +643,7 @@
 filter :: (a -> Bool) -> Set a -> Set a
 filter _ Tip = Tip
 filter p (Bin _ x l r)
-    | p x       = join x (filter p l) (filter p r)
+    | p x       = link x (filter p l) (filter p r)
     | otherwise = merge (filter p l) (filter p r)
 
 -- | /O(n)/. Partition the set into two sets, one with all elements that satisfy
@@ -654,8 +655,8 @@
     go _ Tip = (Tip :*: Tip)
     go p (Bin _ x l r) = case (go p l, go p r) of
       ((l1 :*: l2), (r1 :*: r2))
-        | p x       -> join x l1 r1 :*: merge l2 r2
-        | otherwise -> merge l1 r1 :*: join x l2 r2
+        | p x       -> link x l1 r1 :*: merge l2 r2
+        | otherwise -> merge l1 r1 :*: link x l2 r2
 
 {----------------------------------------------------------------------
   Map
@@ -825,8 +826,8 @@
     go _ t [x] = insertMax x t
     go s l xs@(x : xss) | not_ordered x xss = fromList' l xs
                         | otherwise = case create s xss of
-                            (r, ys, []) -> go (s `shiftL` 1) (join x l r) ys
-                            (r, _,  ys) -> fromList' (join x l r) ys
+                            (r, ys, []) -> go (s `shiftL` 1) (link x l r) ys
+                            (r, _,  ys) -> fromList' (link x l r) ys
 
     -- The create is returning a triple (tree, xs, ys). Both xs and ys
     -- represent not yet processed elements and only one of them can be nonempty.
@@ -843,7 +844,7 @@
                       (l, [y], zs) -> (insertMax y l, [], zs)
                       (l, ys@(y:yss), _) | not_ordered y yss -> (l, [], ys)
                                          | otherwise -> case create (s `shiftR` 1) yss of
-                                                   (r, zs, ws) -> (join y l r, zs, ws)
+                                                   (r, zs, ws) -> (link y l r, zs, ws)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE fromList #-}
 #endif
@@ -888,7 +889,7 @@
     STRICT_1_OF_3(go)
     go _ t [] = t
     go s l (x : xs) = case create s xs of
-                        (r, ys) -> go (s `shiftL` 1) (join x l r) ys
+                        (r, ys) -> go (s `shiftL` 1) (link x l r) ys
 
     STRICT_1_OF_2(create)
     create _ [] = (Tip, [])
@@ -897,7 +898,7 @@
       | otherwise = case create (s `shiftR` 1) xs of
                       res@(_, []) -> res
                       (l, y:ys) -> case create (s `shiftR` 1) ys of
-                        (r, zs) -> (join y l r, zs)
+                        (r, zs) -> (link y l r, zs)
 
 {--------------------------------------------------------------------
   Eq converts the set to a list. In a lazy setting, this
@@ -1001,7 +1002,7 @@
 filterGt (JustS b) t = filter' b t
   where filter' _   Tip = Tip
         filter' b' (Bin _ x l r) =
-          case compare b' x of LT -> join x (filter' b' l) r
+          case compare b' x of LT -> link x (filter' b' l) r
                                EQ -> r
                                GT -> filter' b' r
 #if __GLASGOW_HASKELL__ >= 700
@@ -1013,7 +1014,7 @@
 filterLt (JustS b) t = filter' b t
   where filter' _   Tip = Tip
         filter' b' (Bin _ x l r) =
-          case compare x b' of LT -> join x l (filter' b' r)
+          case compare x b' of LT -> link x l (filter' b' r)
                                EQ -> l
                                GT -> filter' b' l
 #if __GLASGOW_HASKELL__ >= 700
@@ -1032,8 +1033,8 @@
     go _ Tip = (Tip :*: Tip)
     go x (Bin _ y l r)
       = case compare x y of
-          LT -> let (lt :*: gt) = go x l in (lt :*: join y gt r)
-          GT -> let (lt :*: gt) = go x r in (join y l lt :*: gt)
+          LT -> let (lt :*: gt) = go x l in (lt :*: link y gt r)
+          GT -> let (lt :*: gt) = go x r in (link y l lt :*: gt)
           EQ -> (l :*: r)
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE split #-}
@@ -1046,10 +1047,10 @@
 splitMember x (Bin _ y l r)
    = case compare x y of
        LT -> let (lt, found, gt) = splitMember x l
-                 gt' = join y gt r
+                 gt' = link y gt r
              in gt' `seq` (lt, found, gt')
        GT -> let (lt, found, gt) = splitMember x r
-                 lt' = join y l lt
+                 lt' = link y l lt
              in lt' `seq` (lt', found, gt)
        EQ -> (l, True, r)
 #if __GLASGOW_HASKELL__ >= 700
@@ -1163,7 +1164,7 @@
     [balance x l r]   Restores the balance and size.
                       Assumes that the original tree was balanced and
                       that [l] or [r] has changed by at most one element.
-    [join x l r]      Restores balance and size.
+    [link x l r]      Restores balance and size.
 
   Furthermore, we can construct a new tree from two trees. Both operations
   assume that all values in [l] < all values in [r] and that [l] and [r]
@@ -1173,7 +1174,7 @@
     [merge l r]       Merges two trees and restores balance.
 
   Note: in contrast to Adam's paper, we use (<=) comparisons instead
-  of (<) comparisons in [join], [merge] and [balance].
+  of (<) comparisons in [link], [merge] and [balance].
   Quickcheck (on [difference]) showed that this was necessary in order
   to maintain the invariants. It is quite unsatisfactory that I haven't
   been able to find out why this is actually the case! Fortunately, it
@@ -1181,14 +1182,14 @@
 --------------------------------------------------------------------}
 
 {--------------------------------------------------------------------
-  Join
+  Link
 --------------------------------------------------------------------}
-join :: a -> Set a -> Set a -> Set a
-join x Tip r  = insertMin x r
-join x l Tip  = insertMax x l
-join x l@(Bin sizeL y ly ry) r@(Bin sizeR z lz rz)
-  | delta*sizeL < sizeR  = balanceL z (join x l lz) rz
-  | delta*sizeR < sizeL  = balanceR y ly (join x ry r)
+link :: a -> Set a -> Set a -> Set a
+link x Tip r  = insertMin x r
+link x l Tip  = insertMax x l
+link x l@(Bin sizeL y ly ry) r@(Bin sizeR z lz rz)
+  | delta*sizeL < sizeR  = balanceL z (link x l lz) rz
+  | delta*sizeR < sizeL  = balanceR y ly (link x ry r)
   | otherwise            = bin x l r
 
 
@@ -1403,6 +1404,32 @@
     go z []     = z
     go z (x:xs) = let z' = f z x in z' `seq` go z' xs
 {-# INLINE foldlStrict #-}
+
+-- | /O(1)/.  Decompose a set into pieces based on the structure of the underlying
+-- tree.  This function is useful for consuming a set in parallel.
+--
+-- No guarantee is made as to the sizes of the pieces; an internal, but
+-- deterministic process determines this.  However, it is guaranteed that the pieces
+-- returned will be in ascending order (all elements in the first subset less than all
+-- elements in the second, and so on).
+--
+-- Examples:
+--
+-- > splitRoot (fromList [1..6]) ==
+-- >   [fromList [1,2,3],fromList [4],fromList [5,6]]
+--
+-- > splitRoot empty == []
+--
+--  Note that the current implementation does not return more than three subsets,
+--  but you should not depend on this behaviour because it can change in the
+--  future without notice.
+splitRoot :: Set a -> [Set a]
+splitRoot orig =
+  case orig of
+    Tip           -> []
+    Bin _ v l r -> [l, singleton v, r]
+{-# INLINE splitRoot #-}
+
 
 {--------------------------------------------------------------------
   Debugging
diff --git a/containers.cabal b/containers.cabal
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,5 +1,5 @@
 name: containers
-version: 0.5.3.1
+version: 0.5.4.0
 license: BSD3
 license-file: LICENSE
 maintainer: fox@ucw.cz
diff --git a/tests/intmap-properties.hs b/tests/intmap-properties.hs
--- a/tests/intmap-properties.hs
+++ b/tests/intmap-properties.hs
@@ -160,6 +160,7 @@
              , testProperty "fmap"                 prop_fmap
              , testProperty "mapkeys"              prop_mapkeys
              , testProperty "split"                prop_splitModel
+             , testProperty "splitRoot"            prop_splitRoot
              , testProperty "foldr"                prop_foldr
              , testProperty "foldr'"               prop_foldr'
              , testProperty "foldl"                prop_foldl
@@ -993,6 +994,16 @@
       (l, r) = split n $ fromList xs
   in  toAscList l == sort [(k, v) | (k,v) <- xs, k < n] &&
       toAscList r == sort [(k, v) | (k,v) <- xs, k > n]
+
+prop_splitRoot :: IMap -> Bool
+prop_splitRoot s = loop ls && (s == unions ls)
+ where
+  ls = splitRoot s
+  loop [] = True
+  loop (s1:rst) = List.null
+                  [ (x,y) | x <- toList s1
+                          , y <- toList (unions rst)
+                          , x > y ]
 
 prop_foldr :: Int -> [(Int, Int)] -> Property
 prop_foldr n ys = length ys > 0 ==>
diff --git a/tests/intset-properties.hs b/tests/intset-properties.hs
--- a/tests/intset-properties.hs
+++ b/tests/intset-properties.hs
@@ -63,6 +63,7 @@
                    , testProperty "prop_minView" prop_minView
                    , testProperty "prop_split" prop_split
                    , testProperty "prop_splitMember" prop_splitMember
+                   , testProperty "prop_splitRoot" prop_splitRoot
                    , testProperty "prop_partition" prop_partition
                    , testProperty "prop_filter" prop_filter
 #if MIN_VERSION_base(4,5,0)
@@ -307,6 +308,16 @@
 prop_splitMember :: IntSet -> Int -> Bool
 prop_splitMember s i = case splitMember i s of
     (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
+
+prop_splitRoot :: IntSet -> Bool
+prop_splitRoot s = loop ls && (s == unions ls)
+ where
+  ls = splitRoot s
+  loop [] = True
+  loop (s1:rst) = List.null
+                  [ (x,y) | x <- toList s1
+                          , y <- toList (unions rst)
+                          , x > y ]
 
 prop_partition :: IntSet -> Int -> Bool
 prop_partition s i = case partition odd s of
diff --git a/tests/map-properties.hs b/tests/map-properties.hs
--- a/tests/map-properties.hs
+++ b/tests/map-properties.hs
@@ -136,7 +136,8 @@
          , testProperty "deleteMin"            prop_deleteMin
          , testProperty "deleteMax"            prop_deleteMax
          , testProperty "split"                prop_split
-         , testProperty "split then join"      prop_join
+         , testProperty "splitRoot"            prop_splitRoot
+         , testProperty "split then link"      prop_link
          , testProperty "split then merge"     prop_merge
          , testProperty "union"                prop_union
          , testProperty "union model"          prop_unionModel
@@ -859,9 +860,19 @@
 prop_split k t = let (r,l) = split k t
                  in (valid r, valid l) == (True, True)
 
-prop_join :: Int -> UMap -> Bool
-prop_join k t = let (l,r) = split k t
-                in valid (join k () l r)
+prop_splitRoot :: UMap -> Bool
+prop_splitRoot s = loop ls && (s == unions ls)
+ where
+  ls = splitRoot s
+  loop [] = True
+  loop (s1:rst) = List.null
+                  [ (x,y) | x <- toList s1
+                          , y <- toList (unions rst)
+                          , x > y ]
+
+prop_link :: Int -> UMap -> Bool
+prop_link k t = let (l,r) = split k t
+                in valid (link k () l r)
 
 prop_merge :: Int -> UMap -> Bool
 prop_merge k t = let (l,r) = split k t
diff --git a/tests/set-properties.hs b/tests/set-properties.hs
--- a/tests/set-properties.hs
+++ b/tests/set-properties.hs
@@ -31,7 +31,7 @@
                    , testProperty "prop_InsertValid" prop_InsertValid
                    , testProperty "prop_InsertDelete" prop_InsertDelete
                    , testProperty "prop_DeleteValid" prop_DeleteValid
-                   , testProperty "prop_Join" prop_Join
+                   , testProperty "prop_Link" prop_Link
                    , testProperty "prop_Merge" prop_Merge
                    , testProperty "prop_UnionValid" prop_UnionValid
                    , testProperty "prop_UnionInsert" prop_UnionInsert
@@ -64,6 +64,7 @@
                    , testProperty "prop_minView" prop_minView
                    , testProperty "prop_split" prop_split
                    , testProperty "prop_splitMember" prop_splitMember
+                   , testProperty "prop_splitRoot" prop_splitRoot
                    , testProperty "prop_partition" prop_partition
                    , testProperty "prop_filter" prop_filter
                    ]
@@ -215,10 +216,10 @@
 {--------------------------------------------------------------------
   Balance
 --------------------------------------------------------------------}
-prop_Join :: Int -> Property
-prop_Join x = forValidUnitTree $ \t ->
+prop_Link :: Int -> Property
+prop_Link x = forValidUnitTree $ \t ->
     let (l,r) = split x t
-    in valid (join x l r)
+    in valid (link x l r)
 
 prop_Merge :: Int -> Property
 prop_Merge x = forValidUnitTree $ \t ->
@@ -358,6 +359,16 @@
 prop_splitMember :: Set Int -> Int -> Bool
 prop_splitMember s i = case splitMember i s of
     (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
+
+prop_splitRoot :: Set Int -> Bool
+prop_splitRoot s = loop ls && (s == unions ls)
+ where
+  ls = splitRoot s
+  loop [] = True
+  loop (s1:rst) = List.null
+                  [ (x,y) | x <- toList s1
+                          , y <- toList (unions rst)
+                          , x > y ]
 
 prop_partition :: Set Int -> Int -> Bool
 prop_partition s i = case partition odd s of