Add test properties for splitRoot.
[packages/containers.git] / Data / IntSet / Base.hs
index c13b8ee..d58583a 100644 (file)
 -- improves the benchmark by circa 10%.
 
 module Data.IntSet.Base (
-            -- * 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
-
-            -- * 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 Text.Read
 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType)
+import Text.Read
 #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
 --------------------------------------------------------------------}
@@ -455,12 +459,12 @@ 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
@@ -498,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)
 
@@ -1016,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
 
@@ -1176,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.
@@ -1210,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
@@ -1277,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,
@@ -1511,18 +1464,6 @@ foldr'Bits prefix f z bm = let lb = lowestBitSet bm
     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
@@ -1543,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 #-}