Add test properties for splitRoot.
[packages/containers.git] / Data / IntSet / Base.hs
index 7e7c1a7..d58583a 100644 (file)
 -- improves the benchmark by circa 10%.
 
 module Data.IntSet.Base (
-            -- * Set type
-              IntSet(..)      -- instance Eq,Show
-
-            -- * Operators
-            , (\\)
-
-            -- * Query
-            , null
-            , size
-            , member
-            , notMember
-            , lookupLT
-            , lookupGT
-            , lookupLE
-            , lookupGE
-            , isSubsetOf
-            , isProperSubsetOf
-
-            -- * Construction
-            , empty
-            , singleton
-            , insert
-            , delete
-
-            -- * Combine
-            , union
-            , unions
-            , difference
-            , intersection
-
-            -- * Filter
-            , filter
-            , partition
-            , split
-            , splitMember
-
-            -- * Map
-            , map
-
-            -- * Folds
-            , foldr
-            , foldl
-            -- ** Strict folds
-            , foldr'
-            , foldl'
-            -- ** Legacy folds
-            , fold
-
-            -- * Min\/Max
-            , findMin
-            , findMax
-            , deleteMin
-            , deleteMax
-            , deleteFindMin
-            , deleteFindMax
-            , maxView
-            , minView
-
-            -- * Conversion
-
-            -- ** List
-            , elems
-            , toList
-            , fromList
-
-            -- ** Ordered list
-            , toAscList
-            , toDescList
-            , fromAscList
-            , fromDistinctAscList
-
-            -- * Debugging
-            , showTree
-            , showTreeWith
-
-            -- * Internals
-            , match
-            , suffixBitMask
-            , prefixBitMask
-            , bitmapOf
-            ) where
-
-
-import Prelude hiding (filter,foldr,foldl,null,map)
-import Data.Bits
+    -- * Set type
+      IntSet(..), Key -- instance Eq,Show
+
+    -- * Operators
+    , (\\)
+
+    -- * Query
+    , null
+    , size
+    , member
+    , notMember
+    , lookupLT
+    , lookupGT
+    , lookupLE
+    , lookupGE
+    , isSubsetOf
+    , isProperSubsetOf
+
+    -- * Construction
+    , empty
+    , singleton
+    , insert
+    , delete
+
+    -- * Combine
+    , union
+    , unions
+    , difference
+    , intersection
+
+    -- * Filter
+    , filter
+    , partition
+    , split
+    , splitMember
+    , splitRoot
+
+    -- * Map
+    , map
+
+    -- * Folds
+    , foldr
+    , foldl
+    -- ** Strict folds
+    , foldr'
+    , foldl'
+    -- ** Legacy folds
+    , fold
+
+    -- * Min\/Max
+    , findMin
+    , findMax
+    , deleteMin
+    , deleteMax
+    , deleteFindMin
+    , deleteFindMax
+    , maxView
+    , minView
+
+    -- * Conversion
+
+    -- ** List
+    , elems
+    , toList
+    , fromList
+
+    -- ** Ordered list
+    , toAscList
+    , toDescList
+    , fromAscList
+    , fromDistinctAscList
+
+    -- * Debugging
+    , showTree
+    , showTreeWith
+
+    -- * Internals
+    , match
+    , suffixBitMask
+    , prefixBitMask
+    , 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
-import Data.Monoid (Monoid(..))
 import Data.Maybe (fromMaybe)
+import Data.Monoid (Monoid(..))
 import Data.Typeable
-import Control.DeepSeq (NFData)
+import Data.Word (Word)
+import Prelude hiding (filter, foldr, foldl, null, map)
 
+import Data.BitUtil
 import Data.StrictPair
 
 #if __GLASGOW_HASKELL__
+import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType)
 import Text.Read
-import Data.Data (Data(..), mkNoRepType)
 #endif
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts ( Word(..), Int(..), build )
-import GHC.Prim ( uncheckedShiftL#, uncheckedShiftRL#, indexInt8OffAddr# )
-#else
-import Data.Word
+import GHC.Exts (Int(..), build)
+import GHC.Prim (indexInt8OffAddr#)
 #endif
 
 -- On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
 #if defined(__GLASGOW_HASKELL__)
-#include "MachDeps.h"
+# include "MachDeps.h"
 #endif
 
 -- Use macros to define strictness of functions.
@@ -209,21 +228,6 @@ intFromNat :: Nat -> Int
 intFromNat w = fromIntegral w
 {-# INLINE intFromNat #-}
 
--- Right and left logical shifts.
-shiftRL, shiftLL :: Nat -> Int -> Nat
-#if __GLASGOW_HASKELL__
-{--------------------------------------------------------------------
-  GHC: use unboxing to get @shiftRL@ and @shiftLL@ inlined.
---------------------------------------------------------------------}
-shiftRL (W# x) (I# i) = W# (uncheckedShiftRL# x i)
-shiftLL (W# x) (I# i) = W# (uncheckedShiftL#  x i)
-#else
-shiftRL x i   = shiftR x i
-shiftLL x i   = shiftL x i
-#endif
-{-# INLINE shiftRL #-}
-{-# INLINE shiftLL #-}
-
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
@@ -260,6 +264,7 @@ data IntSet = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
 type Prefix = Int
 type Mask   = Int
 type BitMap = Word
+type Key    = Int
 
 instance Monoid IntSet where
     mempty  = empty
@@ -273,13 +278,21 @@ instance Monoid IntSet where
 --------------------------------------------------------------------}
 
 -- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
+-- We provide limited reflection services for the sake of data abstraction.
 
 instance Data IntSet where
   gfoldl f z is = z fromList `f` (toList is)
-  toConstr _    = error "toConstr"
-  gunfold _ _   = error "gunfold"
-  dataTypeOf _  = mkNoRepType "Data.IntSet.IntSet"
+  toConstr _     = fromListConstr
+  gunfold k z c  = case constrIndex c of
+    1 -> k (z fromList)
+    _ -> error "gunfold"
+  dataTypeOf _   = intSetDataType
+
+fromListConstr :: Constr
+fromListConstr = mkConstr intSetDataType "fromList" [] Prefix
+
+intSetDataType :: DataType
+intSetDataType = mkDataType "Data.IntSet.Base.IntSet" [fromListConstr]
 
 #endif
 
@@ -303,7 +316,7 @@ size t
 -- | /O(min(n,W))/. Is the value a member of the set?
 
 -- See Note: Local 'go' functions and capturing]
-member :: Int -> IntSet -> Bool
+member :: Key -> IntSet -> Bool
 member x = x `seq` go
   where
     go (Bin p m l r)
@@ -314,7 +327,7 @@ member x = x `seq` go
     go Nil = False
 
 -- | /O(min(n,W))/. Is the element not in the set?
-notMember :: Int -> IntSet -> Bool
+notMember :: Key -> IntSet -> Bool
 notMember k = not . member k
 
 -- | /O(log n)/. Find largest element smaller than the given one.
@@ -323,7 +336,7 @@ notMember k = not . member k
 -- > lookupLT 5 (fromList [3, 5]) == Just 3
 
 -- See Note: Local 'go' functions and capturing.
-lookupLT :: Int -> IntSet -> Maybe Int
+lookupLT :: Key -> IntSet -> Maybe Key
 lookupLT x t = x `seq` case t of
     Bin _ m l r | m < 0 -> if x >= 0 then go r l else go Nil r
     _ -> go Nil t
@@ -344,7 +357,7 @@ lookupLT x t = x `seq` case t of
 -- > lookupGT 5 (fromList [3, 5]) == Nothing
 
 -- See Note: Local 'go' functions and capturing.
-lookupGT :: Int -> IntSet -> Maybe Int
+lookupGT :: Key -> IntSet -> Maybe Key
 lookupGT x t = x `seq` case t of
     Bin _ m l r | m < 0 -> if x >= 0 then go Nil l else go l r
     _ -> go Nil t
@@ -366,7 +379,7 @@ lookupGT x t = x `seq` case t of
 -- > lookupLE 5 (fromList [3, 5]) == Just 5
 
 -- See Note: Local 'go' functions and capturing.
-lookupLE :: Int -> IntSet -> Maybe Int
+lookupLE :: Key -> IntSet -> Maybe Key
 lookupLE x t = x `seq` case t of
     Bin _ m l r | m < 0 -> if x >= 0 then go r l else go Nil r
     _ -> go Nil t
@@ -388,7 +401,7 @@ lookupLE x t = x `seq` case t of
 -- > lookupGE 6 (fromList [3, 5]) == Nothing
 
 -- See Note: Local 'go' functions and capturing.
-lookupGE :: Int -> IntSet -> Maybe Int
+lookupGE :: Key -> IntSet -> Maybe Key
 lookupGE x t = x `seq` case t of
     Bin _ m l r | m < 0 -> if x >= 0 then go Nil l else go l r
     _ -> go Nil t
@@ -406,14 +419,14 @@ lookupGE x t = x `seq` case t of
 
 -- Helper function for lookupGE and lookupGT. It assumes that if a Bin node is
 -- given, it has m > 0.
-unsafeFindMin :: IntSet -> Maybe Int
+unsafeFindMin :: IntSet -> Maybe Key
 unsafeFindMin Nil = Nothing
 unsafeFindMin (Tip kx bm) = Just $ kx + lowestBitSet bm
 unsafeFindMin (Bin _ _ l _) = unsafeFindMin l
 
 -- Helper function for lookupLE and lookupLT. It assumes that if a Bin node is
 -- given, it has m > 0.
-unsafeFindMax :: IntSet -> Maybe Int
+unsafeFindMax :: IntSet -> Maybe Key
 unsafeFindMax Nil = Nothing
 unsafeFindMax (Tip kx bm) = Just $ kx + highestBitSet bm
 unsafeFindMax (Bin _ _ _ r) = unsafeFindMax r
@@ -428,7 +441,7 @@ empty
 {-# INLINE empty #-}
 
 -- | /O(1)/. A set of one element.
-singleton :: Int -> IntSet
+singleton :: Key -> IntSet
 singleton x
   = Tip (prefixOf x) (bitmapOf x)
 {-# INLINE singleton #-}
@@ -438,7 +451,7 @@ singleton x
 --------------------------------------------------------------------}
 -- | /O(min(n,W))/. Add a value to the set. There is no left- or right bias for
 -- IntSets.
-insert :: Int -> IntSet -> IntSet
+insert :: Key -> IntSet -> IntSet
 insert x = x `seq` insertBM (prefixOf x) (bitmapOf x)
 
 -- Helper function for insert and union.
@@ -446,17 +459,17 @@ insertBM :: Prefix -> BitMap -> IntSet -> IntSet
 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
 -- original set when the value was not present.
-delete :: Int -> IntSet -> IntSet
+delete :: Key -> IntSet -> IntSet
 delete x = x `seq` deleteBM (prefixOf x) (bitmapOf x)
 
 -- Deletes all values mentioned in the BitMap from the set.
@@ -489,13 +502,13 @@ union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
   | 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)
 
@@ -643,7 +656,7 @@ isSubsetOf Nil _         = True
   Filter
 --------------------------------------------------------------------}
 -- | /O(n)/. Filter all elements that satisfy some predicate.
-filter :: (Int -> Bool) -> IntSet -> IntSet
+filter :: (Key -> Bool) -> IntSet -> IntSet
 filter predicate t
   = case t of
       Bin p m l r
@@ -656,7 +669,7 @@ filter predicate t
         {-# INLINE bitPred #-}
 
 -- | /O(n)/. partition the set according to some predicate.
-partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)
+partition :: (Key -> Bool) -> IntSet -> (IntSet,IntSet)
 partition predicate0 t0 = toPair $ go predicate0 t0
   where
     go predicate t
@@ -679,7 +692,7 @@ partition predicate0 t0 = toPair $ go predicate0 t0
 -- comprises the elements of @set@ greater than @x@.
 --
 -- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])
-split :: Int -> IntSet -> (IntSet,IntSet)
+split :: Key -> IntSet -> (IntSet,IntSet)
 split x t =
   case t of
       Bin _ m l r
@@ -710,7 +723,7 @@ split x t =
 
 -- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
 -- element was found in the original set.
-splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet)
+splitMember :: Key -> IntSet -> (IntSet,Bool,IntSet)
 splitMember x t =
   case t of
       Bin _ m l r | m < 0 -> if x >= 0
@@ -749,7 +762,7 @@ splitMember x t =
 
 -- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set
 -- stripped of that element, or 'Nothing' if passed an empty set.
-maxView :: IntSet -> Maybe (Int, IntSet)
+maxView :: IntSet -> Maybe (Key, IntSet)
 maxView t =
   case t of Nil -> Nothing
             Bin p m l r | m < 0 -> case go l of (result, l') -> Just (result, bin p m l' r)
@@ -761,7 +774,7 @@ maxView t =
 
 -- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set
 -- stripped of that element, or 'Nothing' if passed an empty set.
-minView :: IntSet -> Maybe (Int, IntSet)
+minView :: IntSet -> Maybe (Key, IntSet)
 minView t =
   case t of Nil -> Nothing
             Bin p m l r | m < 0 -> case go r of (result, r') -> Just (result, bin p m l r')
@@ -774,18 +787,18 @@ minView t =
 -- | /O(min(n,W))/. Delete and find the minimal element.
 --
 -- > deleteFindMin set = (findMin set, deleteMin set)
-deleteFindMin :: IntSet -> (Int, IntSet)
+deleteFindMin :: IntSet -> (Key, IntSet)
 deleteFindMin = fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView
 
 -- | /O(min(n,W))/. Delete and find the maximal element.
 --
 -- > deleteFindMax set = (findMax set, deleteMax set)
-deleteFindMax :: IntSet -> (Int, IntSet)
+deleteFindMax :: IntSet -> (Key, IntSet)
 deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView
 
 
 -- | /O(min(n,W))/. The minimal element of the set.
-findMin :: IntSet -> Int
+findMin :: IntSet -> Key
 findMin Nil = error "findMin: empty set has no minimal element"
 findMin (Tip kx bm) = kx + lowestBitSet bm
 findMin (Bin _ m l r)
@@ -796,7 +809,7 @@ findMin (Bin _ m l r)
           find Nil            = error "findMin Nil"
 
 -- | /O(min(n,W))/. The maximal element of a set.
-findMax :: IntSet -> Int
+findMax :: IntSet -> Key
 findMax Nil = error "findMax: empty set has no maximal element"
 findMax (Tip kx bm) = kx + highestBitSet bm
 findMax (Bin _ m l r)
@@ -807,11 +820,17 @@ findMax (Bin _ m l r)
           find Nil            = error "findMax Nil"
 
 
--- | /O(min(n,W))/. Delete the minimal element.
+-- | /O(min(n,W))/. Delete the minimal element. Returns an empty set if the set is empty.
+--
+-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;
+-- versions prior to 0.5 threw an error if the 'IntSet' was already empty.
 deleteMin :: IntSet -> IntSet
 deleteMin = maybe Nil snd . minView
 
--- | /O(min(n,W))/. Delete the maximal element.
+-- | /O(min(n,W))/. Delete the maximal element. Returns an empty set if the set is empty.
+--
+-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;
+-- versions prior to 0.5 threw an error if the 'IntSet' was already empty.
 deleteMax :: IntSet -> IntSet
 deleteMax = maybe Nil snd . maxView
 
@@ -825,7 +844,7 @@ deleteMax = maybe Nil snd . maxView
 -- It's worth noting that the size of the result may be smaller if,
 -- for some @(x,y)@, @x \/= y && f x == f y@
 
-map :: (Int->Int) -> IntSet -> IntSet
+map :: (Key -> Key) -> IntSet -> IntSet
 map f = fromList . List.map f . toList
 
 {--------------------------------------------------------------------
@@ -836,7 +855,7 @@ map f = fromList . List.map f . toList
 -- for compatibility only.
 --
 -- /Please note that fold will be deprecated in the future and removed./
-fold :: (Int -> b -> b) -> b -> IntSet -> b
+fold :: (Key -> b -> b) -> b -> IntSet -> b
 fold = foldr
 {-# INLINE fold #-}
 
@@ -846,7 +865,7 @@ fold = foldr
 -- For example,
 --
 -- > toAscList set = foldr (:) [] set
-foldr :: (Int -> b -> b) -> b -> IntSet -> b
+foldr :: (Key -> b -> b) -> b -> IntSet -> b
 foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
                         | otherwise -> go (go z r) l
@@ -860,7 +879,7 @@ foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 -- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
 -- evaluated before using the result in the next application. This
 -- function is strict in the starting value.
-foldr' :: (Int -> b -> b) -> b -> IntSet -> b
+foldr' :: (Key -> b -> b) -> b -> IntSet -> b
 foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
                         | otherwise -> go (go z r) l
@@ -878,7 +897,7 @@ foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 -- For example,
 --
 -- > toDescList set = foldl (flip (:)) [] set
-foldl :: (a -> Int -> a) -> a -> IntSet -> a
+foldl :: (a -> Key -> a) -> a -> IntSet -> a
 foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
                         | otherwise -> go (go z l) r
@@ -893,7 +912,7 @@ foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 -- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
 -- evaluated before using the result in the next application. This
 -- function is strict in the starting value.
-foldl' :: (a -> Int -> a) -> a -> IntSet -> a
+foldl' :: (a -> Key -> a) -> a -> IntSet -> a
 foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
                         | otherwise -> go (go z l) r
@@ -910,7 +929,7 @@ foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 --------------------------------------------------------------------}
 -- | /O(n)/. An alias of 'toAscList'. The elements of a set in ascending order.
 -- Subject to list fusion.
-elems :: IntSet -> [Int]
+elems :: IntSet -> [Key]
 elems
   = toAscList
 
@@ -918,28 +937,28 @@ elems
   Lists
 --------------------------------------------------------------------}
 -- | /O(n)/. Convert the set to a list of elements. Subject to list fusion.
-toList :: IntSet -> [Int]
+toList :: IntSet -> [Key]
 toList
   = toAscList
 
 -- | /O(n)/. Convert the set to an ascending list of elements. Subject to list
 -- fusion.
-toAscList :: IntSet -> [Int]
+toAscList :: IntSet -> [Key]
 toAscList = foldr (:) []
 
 -- | /O(n)/. Convert the set to a descending list of elements. Subject to list
 -- fusion.
-toDescList :: IntSet -> [Int]
+toDescList :: IntSet -> [Key]
 toDescList = foldl (flip (:)) []
 
 -- List fusion for the list generating functions.
 #if __GLASGOW_HASKELL__
 -- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion.
 -- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude.
-foldrFB :: (Int -> b -> b) -> b -> IntSet -> b
+foldrFB :: (Key -> b -> b) -> b -> IntSet -> b
 foldrFB = foldr
 {-# INLINE[0] foldrFB #-}
-foldlFB :: (a -> Int -> a) -> a -> IntSet -> a
+foldlFB :: (a -> Key -> a) -> a -> IntSet -> a
 foldlFB = foldl
 {-# INLINE[0] foldlFB #-}
 
@@ -963,7 +982,7 @@ foldlFB = foldl
 
 
 -- | /O(n*min(n,W))/. Create a set from a list of integers.
-fromList :: [Int] -> IntSet
+fromList :: [Key] -> IntSet
 fromList xs
   = foldlStrict ins empty xs
   where
@@ -971,7 +990,7 @@ fromList xs
 
 -- | /O(n)/. Build a set from an ascending list of elements.
 -- /The precondition (input list is ascending) is not checked./
-fromAscList :: [Int] -> IntSet
+fromAscList :: [Key] -> IntSet
 fromAscList [] = Nil
 fromAscList (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
   where
@@ -982,7 +1001,7 @@ fromAscList (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
 
 -- | /O(n)/. Build a set from an ascending list of distinct elements.
 -- /The precondition (input list is strictly ascending) is not checked./
-fromDistinctAscList :: [Int] -> IntSet
+fromDistinctAscList :: [Key] -> IntSet
 fromDistinctAscList []         = Nil
 fromDistinctAscList (z0 : zs0) = work (prefixOf z0) (bitmapOf z0) zs0 Nada
   where
@@ -1001,7 +1020,7 @@ fromDistinctAscList (z0 : zs0) = work (prefixOf z0) (bitmapOf z0) zs0 Nada
                  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
 
@@ -1161,16 +1180,16 @@ withEmpty bars = "   ":bars
   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.
@@ -1195,7 +1214,11 @@ tip kx bm = Tip kx bm
 ----------------------------------------------------------------------}
 
 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
@@ -1262,61 +1285,6 @@ branchMask p1 p2
 {-# INLINE branchMask #-}
 
 {----------------------------------------------------------------------
-  Finding the highest bit (mask) in a word [x] can be done efficiently in
-  three ways:
-  * convert to a floating point value and the mantissa tells us the
-    [log2(x)] that corresponds with the highest bit position. The mantissa
-    is retrieved either via the standard C function [frexp] or by some bit
-    twiddling on IEEE compatible numbers (float). Note that one needs to
-    use at least [double] precision for an accurate mantissa of 32 bit
-    numbers.
-  * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
-  * use processor specific assembler instruction (asm).
-
-  The most portable way would be [bit], but is it efficient enough?
-  I have measured the cycle counts of the different methods on an AMD
-  Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
-
-  highestBitMask: method  cycles
-                  --------------
-                   frexp   200
-                   float    33
-                   bit      11
-                   asm      12
-
-  highestBit:     method  cycles
-                  --------------
-                   frexp   195
-                   float    33
-                   bit      11
-                   asm      11
-
-  Wow, the bit twiddling is on today's RISC like machines even faster
-  than a single CISC instruction (BSR)!
-----------------------------------------------------------------------}
-
-{----------------------------------------------------------------------
-  [highestBitMask] returns a word where only the highest bit is set.
-  It is found by first setting all bits in lower positions than the
-  highest bit and than taking an exclusive or with the original value.
-  Allthough the function may look expensive, GHC compiles this into
-  excellent C code that subsequently compiled into highly efficient
-  machine code. The algorithm is derived from Jorg Arndt's FXT library.
-----------------------------------------------------------------------}
-highestBitMask :: Nat -> Nat
-highestBitMask x0
-  = case (x0 .|. shiftRL x0 1) of
-     x1 -> case (x1 .|. shiftRL x1 2) of
-      x2 -> case (x2 .|. shiftRL x2 4) of
-       x3 -> case (x3 .|. shiftRL x3 8) of
-        x4 -> case (x4 .|. shiftRL x4 16) of
-#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32)
-         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
-#endif
-          x6 -> (x6 `xor` (shiftRL x6 1))
-{-# INLINE highestBitMask #-}
-
-{----------------------------------------------------------------------
   To get best performance, we provide fast implementations of
   lowestBitSet, highestBitSet and fold[lr][l]Bits for GHC.
   If the intel bsf and bsr instructions ever become GHC primops,
@@ -1495,10 +1463,15 @@ foldr'Bits prefix f z bm = let lb = lowestBitSet bm
     by Peter Wegner in CACM 3 (1960), 322. (Also discovered independently by
     Derrick Lehmer and published in 1964 in a book edited by Beckenbach.)"
 ----------------------------------------------------------------------}
+
 bitcount :: Int -> Word -> Int
+#if MIN_VERSION_base_4_5_0
+bitcount a x = a + popCount x
+#else
 bitcount a0 x0 = go a0 x0
   where go a 0 = a
         go a x = go (a + 1) (x .&. (x-1))
+#endif
 {-# INLINE bitcount #-}
 
 
@@ -1511,3 +1484,28 @@ foldlStrict f = go
     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.  Further, there are no guarantees about the ordering
+-- relationships of the output subsets.
+--
+-- Examples:
+--     
+-- > splitRoot (fromList [1..120]) == [fromList [1..63],fromList [64..120]]
+-- > splitRoot empty == []
+--
+--  Note that the current implementation will not return more than two subsets, but
+--  you should not depend on this remaining the case in future versions.  Also, the
+--  current version will not continue splitting all the way to individual singleton
+--  sets -- it will stop before that.
+splitRoot :: IntSet -> [IntSet]
+splitRoot orig =
+  case orig of
+    Nil           -> []
+    -- NOTE: we don't currently split below Tip, but we could.    
+    x@(Tip _ _)   -> [x]
+    Bin _ _ l r   -> [l, r]
+{-# INLINE splitRoot #-}