Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/dbc5fb6be82398e391f40f31bbea81b859ceda9a >--------------------------------------------------------------- commit dbc5fb6be82398e391f40f31bbea81b859ceda9a Author: Milan Straka <[email protected]> Date: Tue Apr 24 16:20:29 2012 +0200 On 32-bit architectures, improve highestBitMask. Even on 32-bit architectures, bit shift of size 32 was performed. >--------------------------------------------------------------- Data/IntMap/Base.hs | 7 +++++++ Data/IntSet.hs | 11 +++++++---- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs index c10a5b3..b733475 100644 --- a/Data/IntMap/Base.hs +++ b/Data/IntMap/Base.hs @@ -227,6 +227,11 @@ import GHC.Exts ( Word(..), Int(..), shiftRL#, build ) 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 @@ -1943,7 +1948,9 @@ highestBitMask x0 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 #-} diff --git a/Data/IntSet.hs b/Data/IntSet.hs index 1316a39..ec0162e 100644 --- a/Data/IntSet.hs +++ b/Data/IntSet.hs @@ -182,6 +182,11 @@ import GHC.Prim ( uncheckedShiftL#, uncheckedShiftRL#, indexInt8OffAddr# ) 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 @@ -1188,7 +1193,9 @@ highestBitMask x0 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 #-} @@ -1217,10 +1224,6 @@ foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a {-# INLINE foldrBits #-} {-# INLINE foldr'Bits #-} -#if defined(__GLASGOW_HASKELL__) -#include "MachDeps.h" -#endif - #if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64) {---------------------------------------------------------------------- For lowestBitSet we use wordsize-dependant implementation based on _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
