diff --git a/src/Data/DoubleWord/Base.hs b/src/Data/DoubleWord/Base.hs index 66e1350..6e939b6 100644 --- a/src/Data/DoubleWord/Base.hs +++ b/src/Data/DoubleWord/Base.hs @@ -12,7 +12,7 @@ module Data.DoubleWord.Base DoubleWord(..), UnwrappedAdd(..), UnwrappedMul(..), - LeadingZeroes(..) + ZeroBits(..) ) where import Data.Int @@ -225,10 +225,11 @@ instance UnwrappedMul Int64 where (hiP, lo) = fromIntegral x `unwrappedMul` fromIntegral y hi = fromIntegral (hiP ∷ Word64) + hiX + hiY -class Bits w ⇒ LeadingZeroes w where +class Bits w ⇒ ZeroBits w where leadingZeroes ∷ w → Int + trailingZeroes ∷ w → Int -instance LeadingZeroes Word16 where +instance ZeroBits Word16 where leadingZeroes w | w .&. 0xFF00 == 0 = go8 8 w | otherwise = go8 0 (shiftR w 8) where @@ -239,14 +240,28 @@ instance LeadingZeroes Word16 where | w' .&. 2 /= 0 = off + 2 | w' .&. 1 /= 0 = off + 3 | otherwise = off + 4 + trailingZeroes w | w .&. 0x00FF == 0 = go8 8 (shiftR w 8) + | otherwise = go8 0 w + where + go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4) + | otherwise = go4 off w' + go4 off w' | w' .&. 1 /= 0 = off + | w' .&. 2 /= 0 = off + 1 + | w' .&. 4 /= 0 = off + 2 + | w' .&. 8 /= 0 = off + 3 + | otherwise = off + 4 -instance LeadingZeroes Int16 where +instance ZeroBits Int16 where leadingZeroes w = leadingZeroes w' where w' ∷ Word16 w' = fromIntegral w {-# INLINE leadingZeroes #-} + trailingZeroes w = trailingZeroes w' + where w' ∷ Word16 + w' = fromIntegral w + {-# INLINE trailingZeroes #-} -instance LeadingZeroes Word32 where +instance ZeroBits Word32 where leadingZeroes w | w .&. 0xFFFF0000 == 0 = go16 16 w | otherwise = go16 0 (shiftR w 16) where @@ -259,14 +274,30 @@ instance LeadingZeroes Word32 where | w' .&. 2 /= 0 = off + 2 | w' .&. 1 /= 0 = off + 3 | otherwise = off + 4 + trailingZeroes w | w .&. 0x0000FFFF == 0 = go16 16 (shiftR w 16) + | otherwise = go16 0 w + where + go16 off w' | w' .&. 0x00FF == 0 = go8 (off + 8) (shiftR w' 8) + | otherwise = go8 off w' + go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4) + | otherwise = go4 off w' + go4 off w' | w' .&. 1 /= 0 = off + | w' .&. 2 /= 0 = off + 1 + | w' .&. 4 /= 0 = off + 2 + | w' .&. 8 /= 0 = off + 3 + | otherwise = off + 4 -instance LeadingZeroes Int32 where +instance ZeroBits Int32 where leadingZeroes w = leadingZeroes w' where w' ∷ Word32 w' = fromIntegral w {-# INLINE leadingZeroes #-} + trailingZeroes w = trailingZeroes w' + where w' ∷ Word32 + w' = fromIntegral w + {-# INLINE trailingZeroes #-} -instance LeadingZeroes Word64 where +instance ZeroBits Word64 where #if WORD_SIZE_IN_BITS == 64 leadingZeroes w | w .&. 0xFFFFFFFF00000000 == 0 = go32 32 w | otherwise = go32 0 (shiftR w 32) @@ -282,15 +313,36 @@ instance LeadingZeroes Word64 where | w' .&. 2 /= 0 = off + 2 | w' .&. 1 /= 0 = off + 3 | otherwise = off + 4 + trailingZeroes w | w .&. 0x00000000FFFFFFFF == 0 = go32 32 (shiftR w 32) + | otherwise = go32 0 w + where + go32 off w' | w' .&. 0x0000FFFF == 0 = go16 (off + 16) (shiftR w' 16) + | otherwise = go16 off w' + go16 off w' | w' .&. 0x00FF == 0 = go8 (off + 8) (shiftR w' 8) + | otherwise = go8 off w' + go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4) + | otherwise = go4 off w' + go4 off w' | w' .&. 1 /= 0 = off + | w' .&. 2 /= 0 = off + 1 + | w' .&. 4 /= 0 = off + 2 + | w' .&. 8 /= 0 = off + 3 + | otherwise = off + 4 #else leadingZeroes w | hiZeroes == 32 = 32 + leadingZeroes (loWord w) | otherwise = hiZeroes where hiZeroes = leadingZeroes (hiWord w) + trailingZeroes w | loZeroes == 32 = 32 + trailingZeroes (hiWord w) + | otherwise = loZeroes + where loZeroes = trailingZeroes (loWord w) #endif -instance LeadingZeroes Int64 where +instance ZeroBits Int64 where leadingZeroes w = leadingZeroes w' where w' ∷ Word64 w' = fromIntegral w {-# INLINE leadingZeroes #-} + trailingZeroes w = trailingZeroes w' + where w' ∷ Word64 + w' = fromIntegral w + {-# INLINE trailingZeroes #-} diff --git a/src/Data/DoubleWord/TH.hs b/src/Data/DoubleWord/TH.hs index cc020eb..e9a16d6 100644 --- a/src/Data/DoubleWord/TH.hs +++ b/src/Data/DoubleWord/TH.hs @@ -1178,7 +1178,7 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT = return $ , inline 'popCount #endif ] - , inst ''LeadingZeroes [tp] + , inst ''ZeroBits [tp] {- UNSIGNED: leadingZeroes (W hi lo) = @@ -1202,6 +1202,29 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT = return $ , val y $ appV 'bitSize [SigE (VarE 'undefined) hiT] ] , inline 'leadingZeroes + {- + UNSIGNED: + trailingZeroes (W hi lo) = + if x == y then y + trailingZeroes hi else x + where x = trailingZeroes lo + y = bitSize (undefined ∷ L) + SIGNED: + trailingZeroes (W hi lo) = trailingZeroes (U (fromIntegral hi) lo) + -} + , if signed + then + funHiLo 'trailingZeroes + (appV 'trailingZeroes + [appC ocn [appVN 'fromIntegral [hi], VarE lo]]) + else + funHiLo' 'trailingZeroes + (CondE (appVN '(==) [x, y]) + (appV '(+) [VarE y, appVN 'trailingZeroes [hi]]) + (VarE x)) + [ val x $ appVN 'trailingZeroes [lo] + , val y $ appV 'bitSize [SigE (VarE 'undefined) loT] + ] + , inline 'trailingZeroes ] ] where diff --git a/tests/Tests.hs b/tests/Tests.hs index b2ce332..930c66f 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -17,7 +17,7 @@ import Data.Word import Data.Int import Data.Monoid (mempty) import Data.DoubleWord (UnsignedWord, UnwrappedAdd(..), UnwrappedMul(..), - LeadingZeroes(..)) + ZeroBits(..)) import Types class Iso α τ | τ → α where @@ -47,7 +47,9 @@ instance Iso Int64 II64 where .|. fromIntegral ll main = defaultMainWithOpts - [ arbTestGroup "Word64" (0 ∷ Word64) + [ arbTestGroup "Word32" (0 ∷ Word32) + , arbTestGroup "Int32" (0 ∷ Int32) + , arbTestGroup "Word64" (0 ∷ Word64) , arbTestGroup "Int64" (0 ∷ Int64) , isoTestGroup "|Word32|Word32|" (0 ∷ U64) , isoTestGroup "|Int32|Word32|" (0 ∷ I64) @@ -64,8 +66,9 @@ arbTestGroup name t = [ testProperty "unwrappedAdd" $ prop_unwrappedAddArb t ] , testGroup "UnwrappedMul" [ testProperty "unwrappedMul" $ prop_unwrappedMulArb t ] - , testGroup "LeadingZeroes" - [ testProperty "leadingZeroes" $ prop_leadingZeroesArb t ] + , testGroup "ZeroBits" + [ testProperty "leadingZeroes" $ prop_leadingZeroesArb t + , testProperty "trailingZeroes" $ prop_trailingZeroesArb t ] ] isoTestGroup name t = @@ -115,8 +118,9 @@ isoTestGroup name t = , testProperty "popCount" $ prop_popCount t #endif ] - , testGroup "LeadingZeroes" - [ testProperty "leadingZeroes" $ prop_leadingZeroes t ] + , testGroup "ZeroBits" + [ testProperty "leadingZeroes" $ prop_leadingZeroes t + , testProperty "trailingZeroes" $ prop_trailingZeroes t ] ] prop_unwrappedAddArb ∷ ∀ α @@ -137,7 +141,7 @@ prop_unwrappedMulArb _ x y = p == toInteger x * toInteger y p = toInteger hi * (toInteger (maxBound ∷ UnsignedWord α) + 1) + toInteger lo -prop_leadingZeroesArb ∷ ∀ α . (Num α, LeadingZeroes α) ⇒ α → α → Bool +prop_leadingZeroesArb ∷ ∀ α . (Num α, ZeroBits α) ⇒ α → α → Bool prop_leadingZeroesArb _ x | lz == 0 = testBit x (bs - 1) | lz == bs = x == 0 @@ -145,6 +149,14 @@ prop_leadingZeroesArb _ x where lz = leadingZeroes x bs = bitSize x +prop_trailingZeroesArb ∷ ∀ α . (Num α, ZeroBits α) ⇒ α → α → Bool +prop_trailingZeroesArb _ x + | tz == 0 = testBit x 0 + | tz == bs = x == 0 + | otherwise = shiftL x (bs - tz) == 0 && testBit x tz + where tz = trailingZeroes x + bs = bitSize x + toType ∷ Iso α τ ⇒ τ → α → τ toType _ = fromArbitrary @@ -238,4 +250,5 @@ prop_popCount = propUnary' popCount popCount #endif prop_leadingZeroes = propUnary' leadingZeroes leadingZeroes +prop_trailingZeroes = propUnary' trailingZeroes trailingZeroes