{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Bits
  (
#if MIN_VERSION_base(4,7,0)
  bitsLaws
#endif
  ) where

import Data.Bits
import Data.Proxy (Proxy)
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property)

import qualified Data.Set as S

import Test.QuickCheck.Classes.Internal (Laws(..), myForAllShrink)

-- | Tests the following properties:
--
-- [/Conjunction Idempotence/]
--   @n .&. n ≡ n@
-- [/Disjunction Idempotence/]
--   @n .|. n ≡ n@
-- [/Double Complement/]
--   @complement (complement n) ≡ n@
-- [/Set Bit/]
--   @setBit n i ≡ n .|. bit i@
-- [/Clear Bit/]
--   @clearBit n i ≡ n .&. complement (bit i)@
-- [/Complement Bit/]
--   @complementBit n i ≡ xor n (bit i)@
-- [/Clear Zero/]
--   @clearBit zeroBits i ≡ zeroBits@
-- [/Set Zero/]
--   @setBit zeroBits i ≡ bit i@
-- [/Test Zero/]
--   @testBit zeroBits i ≡ False@
-- [/Pop Zero/]
--   @popCount zeroBits ≡ 0@
-- [/Right Rotation/]
--   @no sign extension → (rotateR n i ≡ (shiftR n i) .|. (shiftL n (finiteBitSize ⊥ - i)))@
-- [/Left Rotation/]
--   @no sign extension → (rotateL n i ≡ (shiftL n i) .|. (shiftR n (finiteBitSize ⊥ - i)))@
-- [/Count Leading Zeros of Zero/]
--   @countLeadingZeros zeroBits ≡ finiteBitSize ⊥@
-- [/Count Trailing Zeros of Zero/]
--   @countTrailingZeros zeroBits ≡ finiteBitSize ⊥@
--
-- All of the useful instances of the 'Bits' typeclass
-- also have 'FiniteBits' instances, so these property
-- tests actually require that instance as well.
--
-- /Note:/ This property test is only available when
-- using @base-4.7@ or newer.
#if MIN_VERSION_base(4,7,0)
bitsLaws :: (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Laws
bitsLaws :: Proxy a -> Laws
bitsLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Bits"
  [ (String
"Conjunction Idempotence", Proxy a -> Property
forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsConjunctionIdempotence Proxy a
p)
  , (String
"Disjunction Idempotence", Proxy a -> Property
forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsDisjunctionIdempotence Proxy a
p)
  , (String
"Double Complement", Proxy a -> Property
forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsDoubleComplement Proxy a
p)
  , (String
"Set Bit", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsSetBit Proxy a
p)
  , (String
"Clear Bit", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsClearBit Proxy a
p)
  , (String
"Complement Bit", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsComplementBit Proxy a
p)
  , (String
"Clear Zero", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsClearZero Proxy a
p)
  , (String
"Set Zero", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsSetZero Proxy a
p)
  , (String
"Test Zero", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsTestZero Proxy a
p)
  , (String
"Pop Zero", Proxy a -> Property
forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsPopZero Proxy a
p)
  , (String
"Right Rotation", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsRightRotation Proxy a
p)
  , (String
"Left Rotation", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsLeftRotation Proxy a
p)
#if MIN_VERSION_base(4,8,0)
  , (String
"Count Leading Zeros of Zero", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsCountLeadingZeros Proxy a
p)
  , (String
"Count Trailing Zeros of Zero", Proxy a -> Property
forall a.
(FiniteBits a, Arbitrary a, Show a) =>
Proxy a -> Property
bitsCountTrailingZeros Proxy a
p)
#endif
  ]
#endif

#if MIN_VERSION_base(4,7,0)
newtype BitIndex a = BitIndex Int

instance FiniteBits a => Arbitrary (BitIndex a) where
  arbitrary :: Gen (BitIndex a)
arbitrary = let n :: Int
n = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then (Int -> BitIndex a) -> Gen Int -> Gen (BitIndex a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> BitIndex a
forall a. Int -> BitIndex a
BitIndex ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    else BitIndex a -> Gen (BitIndex a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> BitIndex a
forall a. Int -> BitIndex a
BitIndex Int
0)
  shrink :: BitIndex a -> [BitIndex a]
shrink (BitIndex Int
x) = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (Int -> BitIndex a) -> [Int] -> [BitIndex a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> BitIndex a
forall a. Int -> BitIndex a
BitIndex (Set Int -> [Int]
forall a. Set a -> [a]
S.toList ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
x Int
2, Int
0])) else []

bitsConjunctionIdempotence :: forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsConjunctionIdempotence :: Proxy a -> Property
bitsConjunctionIdempotence Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n])
  String
"n .&. n"
  (\a
n -> a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
n)
  String
"n"
  (\a
n -> a
n)

bitsDisjunctionIdempotence :: forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsDisjunctionIdempotence :: Proxy a -> Property
bitsDisjunctionIdempotence Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n])
  String
"n .|. n"
  (\a
n -> a
n a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
n)
  String
"n"
  (\a
n -> a
n)

bitsDoubleComplement :: forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsDoubleComplement :: Proxy a -> Property
bitsDoubleComplement Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n])
  String
"complement (complement n)"
  (\a
n -> a -> a
forall a. Bits a => a -> a
complement (a -> a
forall a. Bits a => a -> a
complement a
n))
  String
"n"
  (\a
n -> a
n)

bitsSetBit :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsSetBit :: Proxy a -> Property
bitsSetBit Proxy a
_ = Bool
-> ((a, BitIndex a) -> Bool)
-> ((a, BitIndex a) -> [String])
-> String
-> ((a, BitIndex a) -> a)
-> String
-> ((a, BitIndex a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, BitIndex a) -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a, BitIndex Int
i :: BitIndex a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n, String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"setBit n i"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
n Int
i)
  String
"n .|. bit i"
  (\(a
n,BitIndex Int
i) -> a
n a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a. Bits a => Int -> a
bit Int
i)

bitsClearBit :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsClearBit :: Proxy a -> Property
bitsClearBit Proxy a
_ = Bool
-> ((a, BitIndex a) -> Bool)
-> ((a, BitIndex a) -> [String])
-> String
-> ((a, BitIndex a) -> a)
-> String
-> ((a, BitIndex a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, BitIndex a) -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a, BitIndex Int
i :: BitIndex a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n, String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"clearBit n i"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
n Int
i)
  String
"n .&. complement (bit i)"
  (\(a
n,BitIndex Int
i) -> a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement (Int -> a
forall a. Bits a => Int -> a
bit Int
i))

bitsComplementBit :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsComplementBit :: Proxy a -> Property
bitsComplementBit Proxy a
_ = Bool
-> ((a, BitIndex a) -> Bool)
-> ((a, BitIndex a) -> [String])
-> String
-> ((a, BitIndex a) -> a)
-> String
-> ((a, BitIndex a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, BitIndex a) -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
n :: a, BitIndex Int
i :: BitIndex a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n, String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"complementBit n i"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
complementBit a
n Int
i)
  String
"xor n (bit i)"
  (\(a
n,BitIndex Int
i) -> a -> a -> a
forall a. Bits a => a -> a -> a
xor a
n (Int -> a
forall a. Bits a => Int -> a
bit Int
i))

bitsClearZero :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsClearZero :: Proxy a -> Property
bitsClearZero Proxy a
_ = Bool
-> (BitIndex a -> Bool)
-> (BitIndex a -> [String])
-> String
-> (BitIndex a -> a)
-> String
-> (BitIndex a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> BitIndex a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(BitIndex Int
n :: BitIndex a) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
  String
"clearBit zeroBits n"
  (\(BitIndex Int
n) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
forall a. Bits a => a
zeroBits Int
n :: a)
  String
"zeroBits"
  (\BitIndex a
_ -> a
forall a. Bits a => a
zeroBits)

bitsSetZero :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsSetZero :: Proxy a -> Property
bitsSetZero Proxy a
_ = Bool
-> (BitIndex a -> Bool)
-> (BitIndex a -> [String])
-> String
-> (BitIndex a -> a)
-> String
-> (BitIndex a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> BitIndex a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(BitIndex Int
i :: BitIndex a) -> [String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"setBit zeroBits i"
  (\(BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit (a
forall a. Bits a => a
zeroBits :: a) Int
i)
  String
"bit i"
  (\(BitIndex Int
i) -> Int -> a
forall a. Bits a => Int -> a
bit Int
i)

bitsTestZero :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsTestZero :: Proxy a -> Property
bitsTestZero Proxy a
_ = Bool
-> (BitIndex a -> Bool)
-> (BitIndex a -> [String])
-> String
-> (BitIndex a -> Bool)
-> String
-> (BitIndex a -> Bool)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> BitIndex a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(BitIndex Int
i :: BitIndex a) -> [String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"testBit zeroBits i"
  (\(BitIndex Int
i) -> a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (a
forall a. Bits a => a
zeroBits :: a) Int
i)
  String
"False"
  (\BitIndex a
_ -> Bool
False)

bitsPopZero :: forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property
bitsPopZero :: Proxy a -> Property
bitsPopZero Proxy a
_ = Bool
-> (() -> Bool)
-> (() -> [String])
-> String
-> (() -> Int)
-> String
-> (() -> Int)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\() -> [])
  String
"popCount zeroBits"
  (\() -> a -> Int
forall a. Bits a => a -> Int
popCount (a
forall a. Bits a => a
zeroBits :: a))
  String
"0"
  (\() -> Int
0)

bitsRightRotation :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsRightRotation :: Proxy a -> Property
bitsRightRotation Proxy a
_ = Bool
-> ((a, BitIndex a) -> Bool)
-> ((a, BitIndex a) -> [String])
-> String
-> ((a, BitIndex a) -> a)
-> String
-> ((a, BitIndex a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True
  (\(a
n :: a, BitIndex Int
_ :: BitIndex a) ->
    Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
1) (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  )
  (\(a
n, BitIndex Int
i) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n, String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"rotateR n i"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateR a
n Int
i)
  String
"shiftR n i .|. shiftL n (finiteBitSize ⊥ - i)"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
i a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
n (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))

bitsLeftRotation :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsLeftRotation :: Proxy a -> Property
bitsLeftRotation Proxy a
_ = Bool
-> ((a, BitIndex a) -> Bool)
-> ((a, BitIndex a) -> [String])
-> String
-> ((a, BitIndex a) -> a)
-> String
-> ((a, BitIndex a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True
  (\(a
n :: a, BitIndex Int
_ :: BitIndex a) ->
    Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
1) (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  )
  (\(a
n, BitIndex Int
i) -> [String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n, String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i])
  String
"rotateL n i"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateL a
n Int
i)
  String
"shiftL n i .|. shiftR n (finiteBitSize ⊥ - i)"
  (\(a
n,BitIndex Int
i) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
n Int
i a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))
#endif

#if MIN_VERSION_base(4,8,0)
bitsCountLeadingZeros :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsCountLeadingZeros :: Proxy a -> Property
bitsCountLeadingZeros Proxy a
_ = Bool
-> (() -> Bool)
-> (() -> [String])
-> String
-> (() -> Int)
-> String
-> (() -> Int)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\() -> [])
  String
"countLeadingZeros zeroBits"
  (\() -> a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (a
forall a. Bits a => a
zeroBits :: a))
  String
"finiteBitSize undefined"
  (\() -> a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a))

bitsCountTrailingZeros :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property
bitsCountTrailingZeros :: Proxy a -> Property
bitsCountTrailingZeros Proxy a
_ = Bool
-> (() -> Bool)
-> (() -> [String])
-> String
-> (() -> Int)
-> String
-> (() -> Int)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\() -> [])
  String
"countTrailingZeros zeroBits"
  (\() -> a -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (a
forall a. Bits a => a
zeroBits :: a))
  String
"finiteBitSize undefined"
  (\() -> a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a))
#endif