Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implemented trailingZeroes.
  • Loading branch information
mvv committed Jul 7, 2012
1 parent f270d2b commit f1b967b
Show file tree
Hide file tree
Showing 3 changed files with 104 additions and 16 deletions.
68 changes: 60 additions & 8 deletions src/Data/DoubleWord/Base.hs
Expand Up @@ -12,7 +12,7 @@ module Data.DoubleWord.Base
DoubleWord(..),
UnwrappedAdd(..),
UnwrappedMul(..),
LeadingZeroes(..)
ZeroBits(..)
) where

import Data.Int
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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 #-}

25 changes: 24 additions & 1 deletion src/Data/DoubleWord/TH.hs
Expand Up @@ -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) =
Expand All @@ -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
Expand Down
27 changes: 20 additions & 7 deletions tests/Tests.hs
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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 =
Expand Down Expand Up @@ -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 α
Expand All @@ -137,14 +141,22 @@ 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
| otherwise = shiftR x (bs - lz) == 0 && testBit x (bs - lz - 1)
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

Expand Down Expand Up @@ -238,4 +250,5 @@ prop_popCount = propUnary' popCount popCount
#endif

prop_leadingZeroes = propUnary' leadingZeroes leadingZeroes
prop_trailingZeroes = propUnary' trailingZeroes trailingZeroes

0 comments on commit f1b967b

Please sign in to comment.