diff --git a/Data/BitUtil.hs b/Data/BitUtil.hs new file mode 100644 --- /dev/null +++ b/Data/BitUtil.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ +{-# LANGUAGE MagicHash #-} +#endif +#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.BitUtil +-- Copyright : (c) Clark Gaebel 2012 +-- (c) Johan Tibel 2012 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +----------------------------------------------------------------------------- + +module Data.BitUtil + ( highestBitMask + , shiftLL + , shiftRL + ) where + +-- On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro. +#if defined(__GLASGOW_HASKELL__) +# include "MachDeps.h" +#endif + +import Data.Bits ((.|.), xor) + +#if __GLASGOW_HASKELL__ +import GHC.Exts (Word(..), Int(..)) +import GHC.Prim (uncheckedShiftL#, uncheckedShiftRL#) +#else +import Data.Word (shiftL, shiftR) +#endif + +-- The highestBitMask implementation is based on +-- http://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2 +-- which has been put in the public domain. + +-- | Return a word where only the highest bit is set. +highestBitMask :: Word -> Word +highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1 + x3 = x2 .|. x2 `shiftRL` 2 + x4 = x3 .|. x3 `shiftRL` 4 + x5 = x4 .|. x4 `shiftRL` 8 + x6 = x5 .|. x5 `shiftRL` 16 +#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32) + x7 = x6 .|. x6 `shiftRL` 32 + in x7 `xor` (x7 `shiftRL` 1) +#else + in x6 `xor` (x6 `shiftRL` 1) +#endif +{-# INLINE highestBitMask #-} + +-- Right and left logical shifts. +shiftRL, shiftLL :: Word -> Int -> Word +#if __GLASGOW_HASKELL__ +{-------------------------------------------------------------------- + GHC: use unboxing to get @shiftRL@ 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 #-} diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs --- a/Data/IntMap/Base.hs +++ b/Data/IntMap/Base.hs @@ -46,202 +46,191 @@ -- improves the benchmark by circa 10%. module Data.IntMap.Base ( - -- * Map type - IntMap(..), Key -- instance Eq,Show + -- * Map type + IntMap(..), Key -- instance Eq,Show - -- * Operators - , (!), (\\) + -- * Operators + , (!), (\\) - -- * Query - , null - , size - , member - , notMember - , lookup - , findWithDefault - , lookupLT - , lookupGT - , lookupLE - , lookupGE + -- * Query + , null + , size + , member + , notMember + , lookup + , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE - -- * Construction - , empty - , singleton + -- * Construction + , empty + , singleton - -- ** Insertion - , insert - , insertWith - , insertWithKey - , insertLookupWithKey + -- ** Insertion + , insert + , insertWith + , insertWithKey + , insertLookupWithKey - -- ** Delete\/Update - , delete - , adjust - , adjustWithKey - , update - , updateWithKey - , updateLookupWithKey - , alter + -- ** Delete\/Update + , delete + , adjust + , adjustWithKey + , update + , updateWithKey + , updateLookupWithKey + , alter - -- * Combine + -- * Combine - -- ** Union - , union - , unionWith - , unionWithKey - , unions - , unionsWith + -- ** Union + , union + , unionWith + , unionWithKey + , unions + , unionsWith - -- ** Difference - , difference - , differenceWith - , differenceWithKey + -- ** Difference + , difference + , differenceWith + , differenceWithKey - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithKey + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithKey - -- ** Universal combining function - , mergeWithKey - , mergeWithKey' + -- ** Universal combining function + , mergeWithKey + , mergeWithKey' - -- * Traversal - -- ** Map - , map - , mapWithKey - , traverseWithKey - , mapAccum - , mapAccumWithKey - , mapAccumRWithKey - , mapKeys - , mapKeysWith - , mapKeysMonotonic + -- * Traversal + -- ** Map + , map + , mapWithKey + , traverseWithKey + , mapAccum + , mapAccumWithKey + , mapAccumRWithKey + , mapKeys + , mapKeysWith + , mapKeysMonotonic - -- * Folds - , foldr - , foldl - , foldrWithKey - , foldlWithKey - -- ** Strict folds - , foldr' - , foldl' - , foldrWithKey' - , foldlWithKey' + -- * Folds + , foldr + , foldl + , foldrWithKey + , foldlWithKey + -- ** Strict folds + , foldr' + , foldl' + , foldrWithKey' + , foldlWithKey' - -- * Conversion - , elems - , keys - , assocs - , keysSet - , fromSet + -- * Conversion + , elems + , keys + , assocs + , keysSet + , fromSet - -- ** Lists - , toList - , fromList - , fromListWith - , fromListWithKey + -- ** Lists + , toList + , fromList + , fromListWith + , fromListWithKey - -- ** Ordered lists - , toAscList - , toDescList - , fromAscList - , fromAscListWith - , fromAscListWithKey - , fromDistinctAscList + -- ** Ordered lists + , toAscList + , toDescList + , fromAscList + , fromAscListWith + , fromAscListWithKey + , fromDistinctAscList - -- * Filter - , filter - , filterWithKey - , partition - , partitionWithKey + -- * Filter + , filter + , filterWithKey + , partition + , partitionWithKey - , mapMaybe - , mapMaybeWithKey - , mapEither - , mapEitherWithKey + , mapMaybe + , mapMaybeWithKey + , mapEither + , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup - -- * Submap - , isSubmapOf, isSubmapOfBy - , isProperSubmapOf, isProperSubmapOfBy + -- * Submap + , isSubmapOf, isSubmapOfBy + , isProperSubmapOf, isProperSubmapOfBy - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , updateMin - , updateMax - , updateMinWithKey - , updateMaxWithKey - , minView - , maxView - , minViewWithKey - , maxViewWithKey + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , updateMin + , updateMax + , updateMinWithKey + , updateMaxWithKey + , minView + , maxView + , minViewWithKey + , maxViewWithKey - -- * Debugging - , showTree - , showTreeWith + -- * Debugging + , showTree + , showTreeWith - -- * Internal types - , Mask, Prefix, Nat + -- * Internal types + , Mask, Prefix, Nat - -- * Utility - , natFromInt - , intFromNat - , shiftRL - , shiftLL - , join - , bin - , zero - , nomatch - , match - , mask - , maskW - , shorter - , branchMask - , highestBitMask - , foldlStrict - ) where + -- * Utility + , natFromInt + , intFromNat + , join + , bin + , zero + , nomatch + , match + , mask + , maskW + , shorter + , branchMask + , highestBitMask + , foldlStrict + ) where +import Control.Applicative (Applicative(pure, (<*>)), (<$>)) +import Control.DeepSeq (NFData(rnf)) +import Control.Monad (liftM) import Data.Bits - -import Prelude hiding (lookup,map,filter,foldr,foldl,null) -import qualified Data.IntSet.Base as IntSet -import Data.Monoid (Monoid(..)) -import Data.Maybe (fromMaybe) -import Data.Typeable import qualified Data.Foldable as Foldable +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid(..)) import Data.Traversable (Traversable(traverse)) -import Control.Applicative (Applicative(pure,(<*>)),(<$>)) -import Control.Monad ( liftM ) -import Control.DeepSeq (NFData(rnf)) +import Data.Typeable +import Data.Word (Word) +import Prelude hiding (lookup, map, filter, foldr, foldl, null) +import Data.BitUtil import Data.IntSet.Base (Key) +import qualified Data.IntSet.Base as IntSet import Data.StrictPair #if __GLASGOW_HASKELL__ +import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), + DataType, mkDataType) +import GHC.Exts (build) import Text.Read -import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType) #endif -#if __GLASGOW_HASKELL__ -import GHC.Exts ( Word(..), Int(..), build ) -import GHC.Prim ( uncheckedShiftL#, uncheckedShiftRL# ) -#else -import Data.Word -#endif - --- On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro. -#if defined(__GLASGOW_HASKELL__) -#include "MachDeps.h" -#endif - -- Use macros to define strictness of functions. -- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter. -- We do not use BangPatterns, because they are not in any standard and we @@ -259,22 +248,7 @@ intFromNat = fromIntegral {-# INLINE intFromNat #-} --- Right and left logical shifts. -shiftRL, shiftLL :: Nat -> Key -> Nat -#if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- - GHC: use unboxing to get @shiftRL@ 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 #-} - -{-------------------------------------------------------------------- Types --------------------------------------------------------------------} @@ -282,7 +256,10 @@ -- | A map of integers to values @a@. -- See Note: Order of constructors -data IntMap a = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a) +data IntMap a = Bin {-# UNPACK #-} !Prefix + {-# UNPACK #-} !Mask + !(IntMap a) + !(IntMap a) | Tip {-# UNPACK #-} !Key a | Nil @@ -2066,26 +2043,6 @@ branchMask p1 p2 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2)) {-# INLINE branchMask #-} - --- The highestBitMask implementation is based on --- http://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2 --- which has been put in the public domain. - --- | Return a word where only the highest bit is set. -highestBitMask :: Nat -> Nat -highestBitMask x1 = let x2 = x1 .|. x1 `shiftR` 1 - x3 = x2 .|. x2 `shiftR` 2 - x4 = x3 .|. x3 `shiftR` 4 - x5 = x4 .|. x4 `shiftR` 8 - x6 = x5 .|. x5 `shiftR` 16 -#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32) - x7 = x6 .|. x6 `shiftR` 32 - in x7 `xor` (x7 `shiftR` 1) -#else - in x6 `xor` (x6 `shiftR` 1) -#endif -{-# INLINE highestBitMask #-} - {-------------------------------------------------------------------- Utilities diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs --- a/Data/IntMap/Lazy.hs +++ b/Data/IntMap/Lazy.hs @@ -50,154 +50,154 @@ ----------------------------------------------------------------------------- module Data.IntMap.Lazy ( - -- * Strictness properties - -- $strictness + -- * Strictness properties + -- $strictness - -- * Map type + -- * Map type #if !defined(TESTING) - IntMap, Key -- instance Eq,Show + IntMap, Key -- instance Eq,Show #else - IntMap(..), Key -- instance Eq,Show + IntMap(..), Key -- instance Eq,Show #endif - -- * Operators - , (!), (\\) + -- * Operators + , (!), (\\) - -- * Query - , IM.null - , size - , member - , notMember - , IM.lookup - , findWithDefault - , lookupLT - , lookupGT - , lookupLE - , lookupGE + -- * Query + , IM.null + , size + , member + , notMember + , IM.lookup + , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE - -- * Construction - , empty - , singleton + -- * Construction + , empty + , singleton - -- ** Insertion - , insert - , insertWith - , insertWithKey - , insertLookupWithKey + -- ** Insertion + , insert + , insertWith + , insertWithKey + , insertLookupWithKey - -- ** Delete\/Update - , delete - , adjust - , adjustWithKey - , update - , updateWithKey - , updateLookupWithKey - , alter + -- ** Delete\/Update + , delete + , adjust + , adjustWithKey + , update + , updateWithKey + , updateLookupWithKey + , alter - -- * Combine + -- * Combine - -- ** Union - , union - , unionWith - , unionWithKey - , unions - , unionsWith + -- ** Union + , union + , unionWith + , unionWithKey + , unions + , unionsWith - -- ** Difference - , difference - , differenceWith - , differenceWithKey + -- ** Difference + , difference + , differenceWith + , differenceWithKey - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithKey + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithKey - -- ** Universal combining function - , mergeWithKey + -- ** Universal combining function + , mergeWithKey - -- * Traversal - -- ** Map - , IM.map - , mapWithKey - , traverseWithKey - , mapAccum - , mapAccumWithKey - , mapAccumRWithKey - , mapKeys - , mapKeysWith - , mapKeysMonotonic + -- * Traversal + -- ** Map + , IM.map + , mapWithKey + , traverseWithKey + , mapAccum + , mapAccumWithKey + , mapAccumRWithKey + , mapKeys + , mapKeysWith + , mapKeysMonotonic - -- * Folds - , IM.foldr - , IM.foldl - , foldrWithKey - , foldlWithKey - -- ** Strict folds - , foldr' - , foldl' - , foldrWithKey' - , foldlWithKey' + -- * Folds + , IM.foldr + , IM.foldl + , foldrWithKey + , foldlWithKey + -- ** Strict folds + , foldr' + , foldl' + , foldrWithKey' + , foldlWithKey' - -- * Conversion - , elems - , keys - , assocs - , keysSet - , fromSet + -- * Conversion + , elems + , keys + , assocs + , keysSet + , fromSet - -- ** Lists - , toList - , fromList - , fromListWith - , fromListWithKey + -- ** Lists + , toList + , fromList + , fromListWith + , fromListWithKey - -- ** Ordered lists - , toAscList - , toDescList - , fromAscList - , fromAscListWith - , fromAscListWithKey - , fromDistinctAscList + -- ** Ordered lists + , toAscList + , toDescList + , fromAscList + , fromAscListWith + , fromAscListWithKey + , fromDistinctAscList - -- * Filter - , IM.filter - , filterWithKey - , partition - , partitionWithKey + -- * Filter + , IM.filter + , filterWithKey + , partition + , partitionWithKey - , mapMaybe - , mapMaybeWithKey - , mapEither - , mapEitherWithKey + , mapMaybe + , mapMaybeWithKey + , mapEither + , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup - -- * Submap - , isSubmapOf, isSubmapOfBy - , isProperSubmapOf, isProperSubmapOfBy + -- * Submap + , isSubmapOf, isSubmapOfBy + , isProperSubmapOf, isProperSubmapOfBy - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , updateMin - , updateMax - , updateMinWithKey - , updateMaxWithKey - , minView - , maxView - , minViewWithKey - , maxViewWithKey + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , updateMin + , updateMax + , updateMinWithKey + , updateMaxWithKey + , minView + , maxView + , minViewWithKey + , maxViewWithKey - -- * Debugging - , showTree - , showTreeWith - ) where + -- * Debugging + , showTree + , showTreeWith + ) where import Data.IntMap.Base as IM diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs --- a/Data/IntMap/Strict.hs +++ b/Data/IntMap/Strict.hs @@ -56,154 +56,154 @@ -- See the notes at the beginning of Data.IntMap.Base. module Data.IntMap.Strict ( - -- * Strictness properties - -- $strictness + -- * Strictness properties + -- $strictness - -- * Map type + -- * Map type #if !defined(TESTING) - IntMap, Key -- instance Eq,Show + IntMap, Key -- instance Eq,Show #else - IntMap(..), Key -- instance Eq,Show + IntMap(..), Key -- instance Eq,Show #endif - -- * Operators - , (!), (\\) + -- * Operators + , (!), (\\) - -- * Query - , null - , size - , member - , notMember - , lookup - , findWithDefault - , lookupLT - , lookupGT - , lookupLE - , lookupGE + -- * Query + , null + , size + , member + , notMember + , lookup + , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE - -- * Construction - , empty - , singleton + -- * Construction + , empty + , singleton - -- ** Insertion - , insert - , insertWith - , insertWithKey - , insertLookupWithKey + -- ** Insertion + , insert + , insertWith + , insertWithKey + , insertLookupWithKey - -- ** Delete\/Update - , delete - , adjust - , adjustWithKey - , update - , updateWithKey - , updateLookupWithKey - , alter + -- ** Delete\/Update + , delete + , adjust + , adjustWithKey + , update + , updateWithKey + , updateLookupWithKey + , alter - -- * Combine + -- * Combine - -- ** Union - , union - , unionWith - , unionWithKey - , unions - , unionsWith + -- ** Union + , union + , unionWith + , unionWithKey + , unions + , unionsWith - -- ** Difference - , difference - , differenceWith - , differenceWithKey + -- ** Difference + , difference + , differenceWith + , differenceWithKey - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithKey + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithKey - -- ** Universal combining function - , mergeWithKey + -- ** Universal combining function + , mergeWithKey - -- * Traversal - -- ** Map - , map - , mapWithKey - , traverseWithKey - , mapAccum - , mapAccumWithKey - , mapAccumRWithKey - , mapKeys - , mapKeysWith - , mapKeysMonotonic + -- * Traversal + -- ** Map + , map + , mapWithKey + , traverseWithKey + , mapAccum + , mapAccumWithKey + , mapAccumRWithKey + , mapKeys + , mapKeysWith + , mapKeysMonotonic - -- * Folds - , foldr - , foldl - , foldrWithKey - , foldlWithKey - -- ** Strict folds - , foldr' - , foldl' - , foldrWithKey' - , foldlWithKey' + -- * Folds + , foldr + , foldl + , foldrWithKey + , foldlWithKey + -- ** Strict folds + , foldr' + , foldl' + , foldrWithKey' + , foldlWithKey' - -- * Conversion - , elems - , keys - , assocs - , keysSet - , fromSet + -- * Conversion + , elems + , keys + , assocs + , keysSet + , fromSet - -- ** Lists - , toList - , fromList - , fromListWith - , fromListWithKey + -- ** Lists + , toList + , fromList + , fromListWith + , fromListWithKey - -- ** Ordered lists - , toAscList - , toDescList - , fromAscList - , fromAscListWith - , fromAscListWithKey - , fromDistinctAscList + -- ** Ordered lists + , toAscList + , toDescList + , fromAscList + , fromAscListWith + , fromAscListWithKey + , fromDistinctAscList - -- * Filter - , filter - , filterWithKey - , partition - , partitionWithKey + -- * Filter + , filter + , filterWithKey + , partition + , partitionWithKey - , mapMaybe - , mapMaybeWithKey - , mapEither - , mapEitherWithKey + , mapMaybe + , mapMaybeWithKey + , mapEither + , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup - -- * Submap - , isSubmapOf, isSubmapOfBy - , isProperSubmapOf, isProperSubmapOfBy + -- * Submap + , isSubmapOf, isSubmapOfBy + , isProperSubmapOf, isProperSubmapOfBy - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , updateMin - , updateMax - , updateMinWithKey - , updateMaxWithKey - , minView - , maxView - , minViewWithKey - , maxViewWithKey + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , updateMin + , updateMax + , updateMinWithKey + , updateMaxWithKey + , minView + , maxView + , minViewWithKey + , maxViewWithKey - -- * Debugging - , showTree - , showTreeWith - ) where + -- * Debugging + , showTree + , showTreeWith + ) where import Prelude hiding (lookup,map,filter,foldr,foldl,null) @@ -252,6 +252,8 @@ , fromAscListWithKey , fromDistinctAscList ) + +import Data.BitUtil import qualified Data.IntSet.Base as IntSet import Data.StrictPair diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs --- a/Data/IntSet/Base.hs +++ b/Data/IntSet/Base.hs @@ -76,115 +76,113 @@ -- improves the benchmark by circa 10%. module Data.IntSet.Base ( - -- * Set type - IntSet(..), Key -- instance Eq,Show - - -- * Operators - , (\\) + -- * Set type + IntSet(..), Key -- instance Eq,Show - -- * Query - , null - , size - , member - , notMember - , lookupLT - , lookupGT - , lookupLE - , lookupGE - , isSubsetOf - , isProperSubsetOf + -- * Operators + , (\\) - -- * Construction - , empty - , singleton - , insert - , delete + -- * Query + , null + , size + , member + , notMember + , lookupLT + , lookupGT + , lookupLE + , lookupGE + , isSubsetOf + , isProperSubsetOf - -- * Combine - , union - , unions - , difference - , intersection + -- * Construction + , empty + , singleton + , insert + , delete - -- * Filter - , filter - , partition - , split - , splitMember + -- * Combine + , union + , unions + , difference + , intersection - -- * Map - , map + -- * Filter + , filter + , partition + , split + , splitMember - -- * Folds - , foldr - , foldl - -- ** Strict folds - , foldr' - , foldl' - -- ** Legacy folds - , fold + -- * Map + , map - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , maxView - , minView + -- * Folds + , foldr + , foldl + -- ** Strict folds + , foldr' + , foldl' + -- ** Legacy folds + , fold - -- * Conversion + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , maxView + , minView - -- ** List - , elems - , toList - , fromList + -- * Conversion - -- ** Ordered list - , toAscList - , toDescList - , fromAscList - , fromDistinctAscList + -- ** List + , elems + , toList + , fromList - -- * Debugging - , showTree - , showTreeWith + -- ** Ordered list + , toAscList + , toDescList + , fromAscList + , fromDistinctAscList - -- * Internals - , match - , suffixBitMask - , prefixBitMask - , bitmapOf - ) where + -- * Debugging + , showTree + , showTreeWith + -- * Internals + , match + , suffixBitMask + , prefixBitMask + , bitmapOf + ) where -import Prelude hiding (filter,foldr,foldl,null,map) +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,22 +207,7 @@ 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 --------------------------------------------------------------------} -- | /O(n+m)/. See 'difference'. @@ -1275,61 +1258,6 @@ branchMask p1 p2 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt 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 diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs --- a/Data/Map/Base.hs +++ b/Data/Map/Base.hs @@ -93,184 +93,185 @@ -- improves the benchmark by up to 10% on x86. module Data.Map.Base ( - -- * Map type - Map(..) -- instance Eq,Show,Read + -- * Map type + Map(..) -- instance Eq,Show,Read - -- * Operators - , (!), (\\) + -- * Operators + , (!), (\\) - -- * Query - , null - , size - , member - , notMember - , lookup - , findWithDefault - , lookupLT - , lookupGT - , lookupLE - , lookupGE + -- * Query + , null + , size + , member + , notMember + , lookup + , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE - -- * Construction - , empty - , singleton + -- * Construction + , empty + , singleton - -- ** Insertion - , insert - , insertWith - , insertWithKey - , insertLookupWithKey + -- ** Insertion + , insert + , insertWith + , insertWithKey + , insertLookupWithKey - -- ** Delete\/Update - , delete - , adjust - , adjustWithKey - , update - , updateWithKey - , updateLookupWithKey - , alter + -- ** Delete\/Update + , delete + , adjust + , adjustWithKey + , update + , updateWithKey + , updateLookupWithKey + , alter - -- * Combine + -- * Combine - -- ** Union - , union - , unionWith - , unionWithKey - , unions - , unionsWith + -- ** Union + , union + , unionWith + , unionWithKey + , unions + , unionsWith - -- ** Difference - , difference - , differenceWith - , differenceWithKey + -- ** Difference + , difference + , differenceWith + , differenceWithKey - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithKey + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithKey - -- ** Universal combining function - , mergeWithKey + -- ** Universal combining function + , mergeWithKey - -- * Traversal - -- ** Map - , map - , mapWithKey - , traverseWithKey - , mapAccum - , mapAccumWithKey - , mapAccumRWithKey - , mapKeys - , mapKeysWith - , mapKeysMonotonic + -- * Traversal + -- ** Map + , map + , mapWithKey + , traverseWithKey + , mapAccum + , mapAccumWithKey + , mapAccumRWithKey + , mapKeys + , mapKeysWith + , mapKeysMonotonic - -- * Folds - , foldr - , foldl - , foldrWithKey - , foldlWithKey - -- ** Strict folds - , foldr' - , foldl' - , foldrWithKey' - , foldlWithKey' + -- * Folds + , foldr + , foldl + , foldrWithKey + , foldlWithKey + -- ** Strict folds + , foldr' + , foldl' + , foldrWithKey' + , foldlWithKey' - -- * Conversion - , elems - , keys - , assocs - , keysSet - , fromSet + -- * Conversion + , elems + , keys + , assocs + , keysSet + , fromSet - -- ** Lists - , toList - , fromList - , fromListWith - , fromListWithKey + -- ** Lists + , toList + , fromList + , fromListWith + , fromListWithKey - -- ** Ordered lists - , toAscList - , toDescList - , fromAscList - , fromAscListWith - , fromAscListWithKey - , fromDistinctAscList + -- ** Ordered lists + , toAscList + , toDescList + , fromAscList + , fromAscListWith + , fromAscListWithKey + , fromDistinctAscList - -- * Filter - , filter - , filterWithKey - , partition - , partitionWithKey + -- * Filter + , filter + , filterWithKey + , partition + , partitionWithKey - , mapMaybe - , mapMaybeWithKey - , mapEither - , mapEitherWithKey + , mapMaybe + , mapMaybeWithKey + , mapEither + , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup - -- * Submap - , isSubmapOf, isSubmapOfBy - , isProperSubmapOf, isProperSubmapOfBy + -- * Submap + , isSubmapOf, isSubmapOfBy + , isProperSubmapOf, isProperSubmapOfBy - -- * Indexed - , lookupIndex - , findIndex - , elemAt - , updateAt - , deleteAt + -- * Indexed + , lookupIndex + , findIndex + , elemAt + , updateAt + , deleteAt - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , updateMin - , updateMax - , updateMinWithKey - , updateMaxWithKey - , minView - , maxView - , minViewWithKey - , maxViewWithKey + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , updateMin + , updateMax + , updateMinWithKey + , updateMaxWithKey + , minView + , maxView + , minViewWithKey + , maxViewWithKey - -- * Debugging - , showTree - , showTreeWith - , valid + -- * Debugging + , showTree + , showTreeWith + , valid - -- Used by the strict version - , bin - , balance - , balanced - , balanceL - , balanceR - , delta - , join - , insertMax - , merge - , glue - , trim - , trimLookupLo - , foldlStrict - , MaybeS(..) - , filterGt - , filterLt - ) where + -- Used by the strict version + , bin + , balance + , balanced + , balanceL + , balanceR + , delta + , join + , insertMax + , merge + , glue + , trim + , trimLookupLo + , foldlStrict + , MaybeS(..) + , filterGt + , filterLt + ) where -import Prelude hiding (lookup,map,filter,foldr,foldl,null) -import qualified Data.Set.Base as Set -import Data.StrictPair +import Control.Applicative (Applicative(..), (<$>)) +import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) +import qualified Data.Foldable as Foldable import Data.Monoid (Monoid(..)) -import Control.Applicative (Applicative(..), (<$>)) +import Data.StrictPair import Data.Traversable (Traversable(traverse)) -import qualified Data.Foldable as Foldable import Data.Typeable -import Control.DeepSeq (NFData(rnf)) +import Prelude hiding (lookup, map, filter, foldr, foldl, null) + +import qualified Data.Set.Base as Set #if __GLASGOW_HASKELL__ import GHC.Exts ( build ) diff --git a/Data/Map/Lazy.hs b/Data/Map/Lazy.hs --- a/Data/Map/Lazy.hs +++ b/Data/Map/Lazy.hs @@ -46,171 +46,171 @@ ----------------------------------------------------------------------------- module Data.Map.Lazy ( - -- * Strictness properties - -- $strictness + -- * Strictness properties + -- $strictness - -- * Map type + -- * Map type #if !defined(TESTING) - Map -- instance Eq,Show,Read + Map -- instance Eq,Show,Read #else - Map(..) -- instance Eq,Show,Read + Map(..) -- instance Eq,Show,Read #endif - -- * Operators - , (!), (\\) + -- * Operators + , (!), (\\) - -- * Query - , M.null - , size - , member - , notMember - , M.lookup - , findWithDefault - , lookupLT - , lookupGT - , lookupLE - , lookupGE + -- * Query + , M.null + , size + , member + , notMember + , M.lookup + , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE - -- * Construction - , empty - , singleton + -- * Construction + , empty + , singleton - -- ** Insertion - , insert - , insertWith - , insertWithKey - , insertLookupWithKey + -- ** Insertion + , insert + , insertWith + , insertWithKey + , insertLookupWithKey - -- ** Delete\/Update - , delete - , adjust - , adjustWithKey - , update - , updateWithKey - , updateLookupWithKey - , alter + -- ** Delete\/Update + , delete + , adjust + , adjustWithKey + , update + , updateWithKey + , updateLookupWithKey + , alter - -- * Combine + -- * Combine - -- ** Union - , union - , unionWith - , unionWithKey - , unions - , unionsWith + -- ** Union + , union + , unionWith + , unionWithKey + , unions + , unionsWith - -- ** Difference - , difference - , differenceWith - , differenceWithKey + -- ** Difference + , difference + , differenceWith + , differenceWithKey - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithKey + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithKey - -- ** Universal combining function - , mergeWithKey + -- ** Universal combining function + , mergeWithKey - -- * Traversal - -- ** Map - , M.map - , mapWithKey - , traverseWithKey - , mapAccum - , mapAccumWithKey - , mapAccumRWithKey - , mapKeys - , mapKeysWith - , mapKeysMonotonic + -- * Traversal + -- ** Map + , M.map + , mapWithKey + , traverseWithKey + , mapAccum + , mapAccumWithKey + , mapAccumRWithKey + , mapKeys + , mapKeysWith + , mapKeysMonotonic - -- * Folds - , M.foldr - , M.foldl - , foldrWithKey - , foldlWithKey - -- ** Strict folds - , foldr' - , foldl' - , foldrWithKey' - , foldlWithKey' + -- * Folds + , M.foldr + , M.foldl + , foldrWithKey + , foldlWithKey + -- ** Strict folds + , foldr' + , foldl' + , foldrWithKey' + , foldlWithKey' - -- * Conversion - , elems - , keys - , assocs - , keysSet - , fromSet + -- * Conversion + , elems + , keys + , assocs + , keysSet + , fromSet - -- ** Lists - , toList - , fromList - , fromListWith - , fromListWithKey + -- ** Lists + , toList + , fromList + , fromListWith + , fromListWithKey - -- ** Ordered lists - , toAscList - , toDescList - , fromAscList - , fromAscListWith - , fromAscListWithKey - , fromDistinctAscList + -- ** Ordered lists + , toAscList + , toDescList + , fromAscList + , fromAscListWith + , fromAscListWithKey + , fromDistinctAscList - -- * Filter - , M.filter - , filterWithKey - , partition - , partitionWithKey + -- * Filter + , M.filter + , filterWithKey + , partition + , partitionWithKey - , mapMaybe - , mapMaybeWithKey - , mapEither - , mapEitherWithKey + , mapMaybe + , mapMaybeWithKey + , mapEither + , mapEitherWithKey - , split - , splitLookup + , split + , splitLookup - -- * Submap - , isSubmapOf, isSubmapOfBy - , isProperSubmapOf, isProperSubmapOfBy + -- * Submap + , isSubmapOf, isSubmapOfBy + , isProperSubmapOf, isProperSubmapOfBy - -- * Indexed - , lookupIndex - , findIndex - , elemAt - , updateAt - , deleteAt + -- * Indexed + , lookupIndex + , findIndex + , elemAt + , updateAt + , deleteAt - -- * Min\/Max - , findMin - , findMax - , deleteMin - , deleteMax - , deleteFindMin - , deleteFindMax - , updateMin - , updateMax - , updateMinWithKey - , updateMaxWithKey - , minView - , maxView - , minViewWithKey - , maxViewWithKey + -- * Min\/Max + , findMin + , findMax + , deleteMin + , deleteMax + , deleteFindMin + , deleteFindMax + , updateMin + , updateMax + , updateMinWithKey + , updateMaxWithKey + , minView + , maxView + , minViewWithKey + , maxViewWithKey - -- * Debugging - , showTree - , showTreeWith - , valid + -- * Debugging + , showTree + , showTreeWith + , valid #if defined(TESTING) - -- * Internals - , bin - , balanced - , join - , merge + -- * Internals + , bin + , balanced + , join + , merge #endif - ) where + ) where import Data.Map.Base as M diff --git a/Data/StrictPair.hs b/Data/StrictPair.hs --- a/Data/StrictPair.hs +++ b/Data/StrictPair.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP #-} +#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703 +{-# LANGUAGE Trustworthy #-} +#endif module Data.StrictPair (StrictPair(..), toPair) where -- | Same as regular Haskell pairs, but (x :*: _|_) = (_|_ :*: y) = diff --git a/containers.cabal b/containers.cabal --- a/containers.cabal +++ b/containers.cabal @@ -1,5 +1,5 @@ name: containers -version: 0.5.2.0 +version: 0.5.2.1 license: BSD3 license-file: LICENSE maintainer: fox@ucw.cz @@ -52,6 +52,7 @@ Data.Sequence Data.Tree other-modules: + Data.BitUtil Data.IntMap.Base Data.IntSet.Base Data.Map.Base