{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NegativeLiterals #-}
#include "MachDeps.h"
module Basement.Bits
( BitOps(..)
, FiniteBitsOps(..)
, Bits
, toBits
, allOne
) where
import Basement.Compat.Base
import Basement.Compat.Natural
import Basement.Numerical.Additive
import Basement.Numerical.Subtractive
import Basement.Numerical.Multiplicative
import Basement.Types.OffsetSize
import Basement.Types.Word128 (Word128)
import qualified Basement.Types.Word128 as Word128
import Basement.Types.Word256 (Word256)
import qualified Basement.Types.Word256 as Word256
import Basement.IntegralConv (wordToInt)
import Basement.Nat
import qualified Prelude
import qualified Data.Bits as OldBits
import Data.Maybe (fromMaybe)
import Data.Proxy
import GHC.Base hiding ((.))
import GHC.Prim
import GHC.Types
import GHC.Word
import GHC.Int
import Basement.Compat.Primitive
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif
class FiniteBitsOps bits where
numberOfBits :: bits -> CountOf Bool
rotateL :: bits -> CountOf Bool -> bits
rotateR :: bits -> CountOf Bool -> bits
popCount :: bits -> CountOf Bool
bitFlip :: bits -> bits
countLeadingZeros :: bits -> CountOf Bool
default countLeadingZeros :: BitOps bits => bits -> CountOf Bool
countLeadingZeros bits
n = CountOf Bool -> CountOf Bool -> CountOf Bool
loop CountOf Bool
stop forall a. Additive a => a
azero
where
stop :: CountOf Bool
stop = forall bits. FiniteBitsOps bits => bits -> CountOf Bool
numberOfBits bits
n
loop :: CountOf Bool -> CountOf Bool -> CountOf Bool
loop CountOf Bool
idx CountOf Bool
count
| CountOf Bool
idx forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
azero = CountOf Bool
count
| forall bits. BitOps bits => bits -> Offset Bool -> Bool
isBitSet bits
n (forall a. CountOf a -> Offset a
sizeAsOffset CountOf Bool
idx) = CountOf Bool
count
| Bool
otherwise = CountOf Bool -> CountOf Bool -> CountOf Bool
loop (forall a. a -> Maybe a -> a
fromMaybe forall a. Additive a => a
azero (CountOf Bool
idx forall a. Subtractive a => a -> a -> Difference a
- CountOf Bool
1)) (CountOf Bool
count forall a. Additive a => a -> a -> a
+ CountOf Bool
1)
countTrailingZeros :: bits -> CountOf Bool
default countTrailingZeros :: BitOps bits => bits -> CountOf Bool
countTrailingZeros bits
n = CountOf Bool -> CountOf Bool
loop forall a. Additive a => a
azero
where
stop :: CountOf Bool
stop = forall bits. FiniteBitsOps bits => bits -> CountOf Bool
numberOfBits bits
n
loop :: CountOf Bool -> CountOf Bool
loop CountOf Bool
count
| CountOf Bool
count forall a. Eq a => a -> a -> Bool
== CountOf Bool
stop = CountOf Bool
count
| forall bits. BitOps bits => bits -> Offset Bool -> Bool
isBitSet bits
n (forall a. CountOf a -> Offset a
sizeAsOffset CountOf Bool
count) = CountOf Bool
count
| Bool
otherwise = CountOf Bool -> CountOf Bool
loop (CountOf Bool
count forall a. Additive a => a -> a -> a
+ CountOf Bool
1)
class BitOps bits where
(.&.) :: bits -> bits -> bits
(.|.) :: bits -> bits -> bits
(.^.) :: bits -> bits -> bits
(.<<.) :: bits -> CountOf Bool -> bits
(.>>.) :: bits -> CountOf Bool -> bits
bit :: Offset Bool -> bits
default bit :: Integral bits => Offset Bool -> bits
bit Offset Bool
n = bits
1 forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. (forall a. Offset a -> CountOf a
offsetAsSize Offset Bool
n)
isBitSet :: bits -> Offset Bool -> Bool
default isBitSet :: (Integral bits, Eq bits) => bits -> Offset Bool -> Bool
isBitSet bits
x Offset Bool
n = bits
x forall bits. BitOps bits => bits -> bits -> bits
.&. (forall bits. BitOps bits => Offset Bool -> bits
bit Offset Bool
n) forall a. Eq a => a -> a -> Bool
/= bits
0
setBit :: bits -> Offset Bool -> bits
default setBit :: Integral bits => bits -> Offset Bool -> bits
setBit bits
x Offset Bool
n = bits
x forall bits. BitOps bits => bits -> bits -> bits
.|. (forall bits. BitOps bits => Offset Bool -> bits
bit Offset Bool
n)
clearBit :: bits -> Offset Bool -> bits
default clearBit :: FiniteBitsOps bits => bits -> Offset Bool -> bits
clearBit bits
x Offset Bool
n = bits
x forall bits. BitOps bits => bits -> bits -> bits
.&. (forall bits. FiniteBitsOps bits => bits -> bits
bitFlip (forall bits. BitOps bits => Offset Bool -> bits
bit Offset Bool
n))
infixl 8 .<<., .>>., `rotateL`, `rotateR`
infixl 7 .&.
infixl 6 .^.
infixl 5 .|.
newtype Bits (n :: Nat) = Bits { forall (n :: Natural). Bits n -> Natural
bitsToNatural :: Natural }
deriving (Int -> Bits n -> ShowS
forall (n :: Natural). Int -> Bits n -> ShowS
forall (n :: Natural). [Bits n] -> ShowS
forall (n :: Natural). Bits n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bits n] -> ShowS
$cshowList :: forall (n :: Natural). [Bits n] -> ShowS
show :: Bits n -> String
$cshow :: forall (n :: Natural). Bits n -> String
showsPrec :: Int -> Bits n -> ShowS
$cshowsPrec :: forall (n :: Natural). Int -> Bits n -> ShowS
Show, Bits n -> Bits n -> Bool
forall (n :: Natural). Bits n -> Bits n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bits n -> Bits n -> Bool
$c/= :: forall (n :: Natural). Bits n -> Bits n -> Bool
== :: Bits n -> Bits n -> Bool
$c== :: forall (n :: Natural). Bits n -> Bits n -> Bool
Eq, Bits n -> Bits n -> Bool
Bits n -> Bits n -> Ordering
Bits n -> Bits n -> Bits n
forall (n :: Natural). Eq (Bits n)
forall (n :: Natural). Bits n -> Bits n -> Bool
forall (n :: Natural). Bits n -> Bits n -> Ordering
forall (n :: Natural). Bits n -> Bits n -> Bits n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bits n -> Bits n -> Bits n
$cmin :: forall (n :: Natural). Bits n -> Bits n -> Bits n
max :: Bits n -> Bits n -> Bits n
$cmax :: forall (n :: Natural). Bits n -> Bits n -> Bits n
>= :: Bits n -> Bits n -> Bool
$c>= :: forall (n :: Natural). Bits n -> Bits n -> Bool
> :: Bits n -> Bits n -> Bool
$c> :: forall (n :: Natural). Bits n -> Bits n -> Bool
<= :: Bits n -> Bits n -> Bool
$c<= :: forall (n :: Natural). Bits n -> Bits n -> Bool
< :: Bits n -> Bits n -> Bool
$c< :: forall (n :: Natural). Bits n -> Bits n -> Bool
compare :: Bits n -> Bits n -> Ordering
$ccompare :: forall (n :: Natural). Bits n -> Bits n -> Ordering
Ord, Typeable)
type SizeValid n = (KnownNat n, 1 <= n)
lift :: Int -> Natural
lift :: Int -> Natural
lift = forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
{-# INLINABLE lift #-}
toBits :: SizeValid n => Natural -> Bits n
toBits :: forall (n :: Natural). SizeValid n => Natural -> Bits n
toBits Natural
nat = forall (n :: Natural). Natural -> Bits n
Bits Natural
nat forall bits. BitOps bits => bits -> bits -> bits
.&. forall (n :: Natural). SizeValid n => Bits n
allOne
allOne :: forall n . SizeValid n => Bits n
allOne :: forall (n :: Natural). SizeValid n => Bits n
allOne = forall (n :: Natural). Natural -> Bits n
Bits (Natural
2 forall a b. (Num a, Integral b) => a -> b -> a
Prelude.^ Integer
n forall a. Num a => a -> a -> a
Prelude.- forall a. Multiplicative a => a
midentity)
where
n :: Integer
n = forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)
instance SizeValid n => Enum (Bits n) where
toEnum :: Int -> Bits n
toEnum Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int -> Natural
lift Int
i forall a. Ord a => a -> a -> Bool
> forall (n :: Natural). Bits n -> Natural
bitsToNatural Bits n
maxi = forall a. HasCallStack => String -> a
error String
"Bits n not within bound"
| Bool
otherwise = forall (n :: Natural). Natural -> Bits n
Bits (Int -> Natural
lift Int
i)
where maxi :: Bits n
maxi = forall (n :: Natural). SizeValid n => Bits n
allOne :: Bits n
fromEnum :: Bits n -> Int
fromEnum (Bits Natural
n) = forall a. Enum a => a -> Int
fromEnum Natural
n
instance SizeValid n => Bounded (Bits n) where
minBound :: Bits n
minBound = forall a. Additive a => a
azero
maxBound :: Bits n
maxBound = forall (n :: Natural). SizeValid n => Bits n
allOne
instance SizeValid n => Additive (Bits n) where
azero :: Bits n
azero = forall (n :: Natural). Natural -> Bits n
Bits Natural
0
+ :: Bits n -> Bits n -> Bits n
(+) (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). SizeValid n => Natural -> Bits n
toBits (Natural
a forall a. Additive a => a -> a -> a
+ Natural
b)
scale :: forall n. IsNatural n => n -> Bits n -> Bits n
scale n
n (Bits Natural
a) = forall (n :: Natural). SizeValid n => Natural -> Bits n
toBits (forall a n. (Additive a, IsNatural n) => n -> a -> a
scale n
n Natural
a)
instance SizeValid n => Subtractive (Bits n) where
type Difference (Bits n) = Bits n
(-) (Bits Natural
a) (Bits Natural
b) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
azero forall (n :: Natural). SizeValid n => Natural -> Bits n
toBits (Natural
a forall a. Subtractive a => a -> a -> Difference a
- Natural
b)
instance SizeValid n => Multiplicative (Bits n) where
midentity :: Bits n
midentity = forall (n :: Natural). Natural -> Bits n
Bits Natural
1
* :: Bits n -> Bits n -> Bits n
(*) (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Num a => a -> a -> a
Prelude.* Natural
b)
instance SizeValid n => IDivisible (Bits n) where
div :: Bits n -> Bits n -> Bits n
div (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Integral a => a -> a -> a
`Prelude.div` Natural
b)
mod :: Bits n -> Bits n -> Bits n
mod (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Integral a => a -> a -> a
`Prelude.mod` Natural
b)
divMod :: Bits n -> Bits n -> (Bits n, Bits n)
divMod (Bits Natural
a) (Bits Natural
b) = let (Natural
q, Natural
r) = forall a. Integral a => a -> a -> (a, a)
Prelude.divMod Natural
a Natural
b in (forall (n :: Natural). Natural -> Bits n
Bits Natural
q, forall (n :: Natural). Natural -> Bits n
Bits Natural
r)
instance SizeValid n => BitOps (Bits n) where
.&. :: Bits n -> Bits n -> Bits n
(.&.) (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Bits a => a -> a -> a
OldBits..&. Natural
b)
.|. :: Bits n -> Bits n -> Bits n
(.|.) (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Bits a => a -> a -> a
OldBits..|. Natural
b)
.^. :: Bits n -> Bits n -> Bits n
(.^.) (Bits Natural
a) (Bits Natural
b) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Bits a => a -> a -> a
`OldBits.xor` Natural
b)
.<<. :: Bits n -> CountOf Bool -> Bits n
(.<<.) (Bits Natural
a) (CountOf Int
w) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Bits n -> CountOf Bool -> Bits n
(.>>.) (Bits Natural
a) (CountOf Int
w) = forall (n :: Natural). Natural -> Bits n
Bits (Natural
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
bit :: Offset Bool -> Bits n
bit (Offset Int
w) = forall (n :: Natural). Natural -> Bits n
Bits (forall a. Bits a => Int -> a
OldBits.bit Int
w)
isBitSet :: Bits n -> Offset Bool -> Bool
isBitSet (Bits Natural
a) (Offset Int
w) = forall a. Bits a => a -> Int -> Bool
OldBits.testBit Natural
a Int
w
setBit :: Bits n -> Offset Bool -> Bits n
setBit (Bits Natural
a) (Offset Int
w) = forall (n :: Natural). Natural -> Bits n
Bits (forall a. Bits a => a -> Int -> a
OldBits.setBit Natural
a Int
w)
clearBit :: Bits n -> Offset Bool -> Bits n
clearBit (Bits Natural
a) (Offset Int
w) = forall (n :: Natural). Natural -> Bits n
Bits (forall a. Bits a => a -> Int -> a
OldBits.clearBit Natural
a Int
w)
instance (SizeValid n, NatWithinBound (CountOf Bool) n) => FiniteBitsOps (Bits n) where
bitFlip :: Bits n -> Bits n
bitFlip (Bits Natural
a) = forall (n :: Natural). Natural -> Bits n
Bits (forall a. Bits a => a -> a
OldBits.complement Natural
a)
numberOfBits :: Bits n -> CountOf Bool
numberOfBits Bits n
_ = forall (n :: Natural) ty (proxy :: Natural -> *).
(KnownNat n, NatWithinBound (CountOf ty) n) =>
proxy n -> CountOf ty
natValCountOf (forall {k} (t :: k). Proxy t
Proxy @n)
rotateL :: Bits n -> CountOf Bool -> Bits n
rotateL Bits n
a CountOf Bool
i = (Bits n
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
i) forall bits. BitOps bits => bits -> bits -> bits
.|. (Bits n
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
d)
where
n :: CountOf Bool
n = forall (n :: Natural) ty (proxy :: Natural -> *).
(KnownNat n, NatWithinBound (CountOf ty) n) =>
proxy n -> CountOf ty
natValCountOf (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
d :: CountOf Bool
d = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"impossible") (CountOf Bool
i forall a. Subtractive a => a -> a -> Difference a
- CountOf Bool
n)) (CountOf Bool
n forall a. Subtractive a => a -> a -> Difference a
- CountOf Bool
i)
rotateR :: Bits n -> CountOf Bool -> Bits n
rotateR Bits n
a CountOf Bool
i = (Bits n
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
i) forall bits. BitOps bits => bits -> bits -> bits
.|. (Bits n
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
d)
where
n :: CountOf Bool
n = forall (n :: Natural) ty (proxy :: Natural -> *).
(KnownNat n, NatWithinBound (CountOf ty) n) =>
proxy n -> CountOf ty
natValCountOf (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
d :: CountOf Bool
d = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"impossible") (CountOf Bool
i forall a. Subtractive a => a -> a -> Difference a
- CountOf Bool
n)) (CountOf Bool
n forall a. Subtractive a => a -> a -> Difference a
- CountOf Bool
i)
popCount :: Bits n -> CountOf Bool
popCount (Bits Natural
n) = forall ty. Int -> CountOf ty
CountOf (forall a. Bits a => a -> Int
OldBits.popCount Natural
n)
instance FiniteBitsOps Bool where
numberOfBits :: Bool -> CountOf Bool
numberOfBits Bool
_ = CountOf Bool
1
rotateL :: Bool -> CountOf Bool -> Bool
rotateL Bool
x CountOf Bool
_ = Bool
x
rotateR :: Bool -> CountOf Bool -> Bool
rotateR Bool
x CountOf Bool
_ = Bool
x
popCount :: Bool -> CountOf Bool
popCount Bool
True = CountOf Bool
1
popCount Bool
False = CountOf Bool
0
bitFlip :: Bool -> Bool
bitFlip = Bool -> Bool
not
countLeadingZeros :: Bool -> CountOf Bool
countLeadingZeros Bool
True = CountOf Bool
0
countLeadingZeros Bool
False = CountOf Bool
1
countTrailingZeros :: Bool -> CountOf Bool
countTrailingZeros Bool
True = CountOf Bool
0
countTrailingZeros Bool
False = CountOf Bool
1
instance BitOps Bool where
.&. :: Bool -> Bool -> Bool
(.&.) = Bool -> Bool -> Bool
(&&)
.|. :: Bool -> Bool -> Bool
(.|.) = Bool -> Bool -> Bool
(||)
.^. :: Bool -> Bool -> Bool
(.^.) = forall a. Eq a => a -> a -> Bool
(/=)
Bool
x .<<. :: Bool -> CountOf Bool -> Bool
.<<. CountOf Bool
0 = Bool
x
Bool
_ .<<. CountOf Bool
_ = Bool
False
Bool
x .>>. :: Bool -> CountOf Bool -> Bool
.>>. CountOf Bool
0 = Bool
x
Bool
_ .>>. CountOf Bool
_ = Bool
False
bit :: Offset Bool -> Bool
bit Offset Bool
0 = Bool
True
bit Offset Bool
_ = Bool
False
isBitSet :: Bool -> Offset Bool -> Bool
isBitSet Bool
x Offset Bool
0 = Bool
x
isBitSet Bool
_ Offset Bool
_ = Bool
False
setBit :: Bool -> Offset Bool -> Bool
setBit Bool
_ Offset Bool
0 = Bool
True
setBit Bool
_ Offset Bool
_ = Bool
False
clearBit :: Bool -> Offset Bool -> Bool
clearBit Bool
_ Offset Bool
0 = Bool
False
clearBit Bool
x Offset Bool
_ = Bool
x
instance FiniteBitsOps Word8 where
numberOfBits :: Word8 -> CountOf Bool
numberOfBits Word8
_ = CountOf Bool
8
rotateL :: Word8 -> CountOf Bool -> Word8
rotateL Word8
w (CountOf Int
i) = Word8
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Word8 -> CountOf Bool -> Word8
rotateR Word8
w (CountOf Int
i) = Word8
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Word8 -> Word8
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Word8 -> CountOf Bool
popCount (W8# Word8#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt8# (Word8# -> Word#
word8ToWord# Word8#
x#)))
countLeadingZeros :: Word8 -> CountOf Bool
countLeadingZeros (W8# Word8#
w) = forall ty. Int -> CountOf ty
CountOf (Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz8# (Word8# -> Word#
word8ToWord# Word8#
w))))
countTrailingZeros :: Word8 -> CountOf Bool
countTrailingZeros (W8# Word8#
w) = forall ty. Int -> CountOf ty
CountOf (Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz8# (Word8# -> Word#
word8ToWord# Word8#
w))))
instance BitOps Word8 where
.&. :: Word8 -> Word8 -> Word8
(.&.) Word8
a Word8
b = (Word8
a forall a. Bits a => a -> a -> a
OldBits..&. Word8
b)
.|. :: Word8 -> Word8 -> Word8
(.|.) Word8
a Word8
b = (Word8
a forall a. Bits a => a -> a -> a
OldBits..|. Word8
b)
.^. :: Word8 -> Word8 -> Word8
(.^.) Word8
a Word8
b = (Word8
a forall a. Bits a => a -> a -> a
`OldBits.xor` Word8
b)
.<<. :: Word8 -> CountOf Bool -> Word8
(.<<.) Word8
a (CountOf Int
w) = (Word8
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Word8 -> CountOf Bool -> Word8
(.>>.) Word8
a (CountOf Int
w) = (Word8
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
instance FiniteBitsOps Word16 where
numberOfBits :: Word16 -> CountOf Bool
numberOfBits Word16
_ = CountOf Bool
16
rotateL :: Word16 -> CountOf Bool -> Word16
rotateL Word16
w (CountOf Int
i) = Word16
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Word16 -> CountOf Bool -> Word16
rotateR Word16
w (CountOf Int
i) = Word16
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Word16 -> Word16
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Word16 -> CountOf Bool
popCount (W16# Word16#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt16# (Word16# -> Word#
word16ToWord# Word16#
x#)))
countLeadingZeros :: Word16 -> CountOf Bool
countLeadingZeros (W16# Word16#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz16# (Word16# -> Word#
word16ToWord# Word16#
w#)))
countTrailingZeros :: Word16 -> CountOf Bool
countTrailingZeros (W16# Word16#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz16# (Word16# -> Word#
word16ToWord# Word16#
w#)))
instance BitOps Word16 where
.&. :: Word16 -> Word16 -> Word16
(.&.) Word16
a Word16
b = (Word16
a forall a. Bits a => a -> a -> a
OldBits..&. Word16
b)
.|. :: Word16 -> Word16 -> Word16
(.|.) Word16
a Word16
b = (Word16
a forall a. Bits a => a -> a -> a
OldBits..|. Word16
b)
.^. :: Word16 -> Word16 -> Word16
(.^.) Word16
a Word16
b = (Word16
a forall a. Bits a => a -> a -> a
`OldBits.xor` Word16
b)
.<<. :: Word16 -> CountOf Bool -> Word16
(.<<.) Word16
a (CountOf Int
w) = (Word16
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Word16 -> CountOf Bool -> Word16
(.>>.) Word16
a (CountOf Int
w) = (Word16
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
instance FiniteBitsOps Word32 where
numberOfBits :: Word32 -> CountOf Bool
numberOfBits Word32
_ = CountOf Bool
32
rotateL :: Word32 -> CountOf Bool -> Word32
rotateL Word32
w (CountOf Int
i) = Word32
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Word32 -> CountOf Bool -> Word32
rotateR Word32
w (CountOf Int
i) = Word32
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Word32 -> Word32
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Word32 -> CountOf Bool
popCount (W32# Word32#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt32# (Word32# -> Word#
word32ToWord# Word32#
x#)))
countLeadingZeros :: Word32 -> CountOf Bool
countLeadingZeros (W32# Word32#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz32# (Word32# -> Word#
word32ToWord# Word32#
w#)))
countTrailingZeros :: Word32 -> CountOf Bool
countTrailingZeros (W32# Word32#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz32# (Word32# -> Word#
word32ToWord# Word32#
w#)))
instance BitOps Word32 where
.&. :: Word32 -> Word32 -> Word32
(.&.) Word32
a Word32
b = (Word32
a forall a. Bits a => a -> a -> a
OldBits..&. Word32
b)
.|. :: Word32 -> Word32 -> Word32
(.|.) Word32
a Word32
b = (Word32
a forall a. Bits a => a -> a -> a
OldBits..|. Word32
b)
.^. :: Word32 -> Word32 -> Word32
(.^.) Word32
a Word32
b = (Word32
a forall a. Bits a => a -> a -> a
`OldBits.xor` Word32
b)
.<<. :: Word32 -> CountOf Bool -> Word32
(.<<.) Word32
a (CountOf Int
w) = (Word32
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Word32 -> CountOf Bool -> Word32
(.>>.) Word32
a (CountOf Int
w) = (Word32
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
#if WORD_SIZE_IN_BITS == 64
instance FiniteBitsOps Word where
numberOfBits :: Word -> CountOf Bool
numberOfBits Word
_ = CountOf Bool
64
rotateL :: Word -> CountOf Bool -> Word
rotateL Word
w (CountOf Int
i) = Word
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Word -> CountOf Bool -> Word
rotateR Word
w (CountOf Int
i) = Word
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Word -> Word
bitFlip = forall a. Bits a => a -> a
OldBits.complement
#if __GLASGOW_HASKELL__ >= 904
popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# (wordToWord64# x#)))
countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# (wordToWord64# w#)))
countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# (wordToWord64# w#)))
#else
popCount :: Word -> CountOf Bool
popCount (W# Word#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt64# Word#
x#))
countLeadingZeros :: Word -> CountOf Bool
countLeadingZeros (W# Word#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz64# Word#
w#))
countTrailingZeros :: Word -> CountOf Bool
countTrailingZeros (W# Word#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz64# Word#
w#))
#endif
#else
instance FiniteBitsOps Word where
numberOfBits _ = 32
rotateL w (CountOf i) = w `OldBits.rotateL` i
rotateR w (CountOf i) = w `OldBits.rotateR` i
bitFlip = OldBits.complement
popCount (W# x#) = CountOf $ wordToInt (W# (popCnt32# x#))
countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz32# w#))
countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz32# w#))
#endif
instance BitOps Word where
.&. :: Word -> Word -> Word
(.&.) Word
a Word
b = (Word
a forall a. Bits a => a -> a -> a
OldBits..&. Word
b)
.|. :: Word -> Word -> Word
(.|.) Word
a Word
b = (Word
a forall a. Bits a => a -> a -> a
OldBits..|. Word
b)
.^. :: Word -> Word -> Word
(.^.) Word
a Word
b = (Word
a forall a. Bits a => a -> a -> a
`OldBits.xor` Word
b)
.<<. :: Word -> CountOf Bool -> Word
(.<<.) Word
a (CountOf Int
w) = (Word
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Word -> CountOf Bool -> Word
(.>>.) Word
a (CountOf Int
w) = (Word
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
#if WORD_SIZE_IN_BITS == 64
instance FiniteBitsOps Word64 where
numberOfBits :: Word64 -> CountOf Bool
numberOfBits Word64
_ = CountOf Bool
64
rotateL :: Word64 -> CountOf Bool -> Word64
rotateL Word64
w (CountOf Int
i) = Word64
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Word64 -> CountOf Bool -> Word64
rotateR Word64
w (CountOf Int
i) = Word64
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Word64 -> Word64
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Word64 -> CountOf Bool
popCount (W64# Word#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt64# Word#
x#))
countLeadingZeros :: Word64 -> CountOf Bool
countLeadingZeros (W64# Word#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz64# Word#
w#))
countTrailingZeros :: Word64 -> CountOf Bool
countTrailingZeros (W64# Word#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz64# Word#
w#))
instance BitOps Word64 where
.&. :: Word64 -> Word64 -> Word64
(.&.) Word64
a Word64
b = (Word64
a forall a. Bits a => a -> a -> a
OldBits..&. Word64
b)
.|. :: Word64 -> Word64 -> Word64
(.|.) Word64
a Word64
b = (Word64
a forall a. Bits a => a -> a -> a
OldBits..|. Word64
b)
.^. :: Word64 -> Word64 -> Word64
(.^.) Word64
a Word64
b = (Word64
a forall a. Bits a => a -> a -> a
`OldBits.xor` Word64
b)
.<<. :: Word64 -> CountOf Bool -> Word64
(.<<.) Word64
a (CountOf Int
w) = (Word64
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Word64 -> CountOf Bool -> Word64
(.>>.) Word64
a (CountOf Int
w) = (Word64
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
#else
instance FiniteBitsOps Word64 where
numberOfBits _ = 64
rotateL w (CountOf i) = w `OldBits.rotateL` i
rotateR w (CountOf i) = w `OldBits.rotateR` i
bitFlip = OldBits.complement
popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#))
countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#))
countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#))
instance BitOps Word64 where
(.&.) a b = (a OldBits..&. b)
(.|.) a b = (a OldBits..|. b)
(.^.) a b = (a `OldBits.xor` b)
(.<<.) a (CountOf w) = (a `OldBits.shiftL` w)
(.>>.) a (CountOf w) = (a `OldBits.shiftR` w)
#endif
instance FiniteBitsOps Word128 where
numberOfBits :: Word128 -> CountOf Bool
numberOfBits Word128
_ = CountOf Bool
128
rotateL :: Word128 -> CountOf Bool -> Word128
rotateL Word128
w (CountOf Int
n) = Word128 -> Int -> Word128
Word128.rotateL Word128
w Int
n
rotateR :: Word128 -> CountOf Bool -> Word128
rotateR Word128
w (CountOf Int
n) = Word128 -> Int -> Word128
Word128.rotateR Word128
w Int
n
bitFlip :: Word128 -> Word128
bitFlip = Word128 -> Word128
Word128.complement
popCount :: Word128 -> CountOf Bool
popCount = forall ty. Int -> CountOf ty
CountOf forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word128 -> Int
Word128.popCount
instance BitOps Word128 where
.&. :: Word128 -> Word128 -> Word128
(.&.) = Word128 -> Word128 -> Word128
Word128.bitwiseAnd
.|. :: Word128 -> Word128 -> Word128
(.|.) = Word128 -> Word128 -> Word128
Word128.bitwiseOr
.^. :: Word128 -> Word128 -> Word128
(.^.) = Word128 -> Word128 -> Word128
Word128.bitwiseXor
.<<. :: Word128 -> CountOf Bool -> Word128
(.<<.) Word128
w (CountOf Int
n) = Word128 -> Int -> Word128
Word128.shiftL Word128
w Int
n
.>>. :: Word128 -> CountOf Bool -> Word128
(.>>.) Word128
w (CountOf Int
n) = Word128 -> Int -> Word128
Word128.shiftR Word128
w Int
n
instance FiniteBitsOps Word256 where
numberOfBits :: Word256 -> CountOf Bool
numberOfBits Word256
_ = CountOf Bool
256
rotateL :: Word256 -> CountOf Bool -> Word256
rotateL Word256
w (CountOf Int
n) = Word256 -> Int -> Word256
Word256.rotateL Word256
w Int
n
rotateR :: Word256 -> CountOf Bool -> Word256
rotateR Word256
w (CountOf Int
n) = Word256 -> Int -> Word256
Word256.rotateR Word256
w Int
n
bitFlip :: Word256 -> Word256
bitFlip = Word256 -> Word256
Word256.complement
popCount :: Word256 -> CountOf Bool
popCount = forall ty. Int -> CountOf ty
CountOf forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word256 -> Int
Word256.popCount
instance BitOps Word256 where
.&. :: Word256 -> Word256 -> Word256
(.&.) = Word256 -> Word256 -> Word256
Word256.bitwiseAnd
.|. :: Word256 -> Word256 -> Word256
(.|.) = Word256 -> Word256 -> Word256
Word256.bitwiseOr
.^. :: Word256 -> Word256 -> Word256
(.^.) = Word256 -> Word256 -> Word256
Word256.bitwiseXor
.<<. :: Word256 -> CountOf Bool -> Word256
(.<<.) Word256
w (CountOf Int
n) = Word256 -> Int -> Word256
Word256.shiftL Word256
w Int
n
.>>. :: Word256 -> CountOf Bool -> Word256
(.>>.) Word256
w (CountOf Int
n) = Word256 -> Int -> Word256
Word256.shiftR Word256
w Int
n
instance FiniteBitsOps Int8 where
numberOfBits :: Int8 -> CountOf Bool
numberOfBits Int8
_ = CountOf Bool
8
rotateL :: Int8 -> CountOf Bool -> Int8
rotateL Int8
w (CountOf Int
i) = Int8
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Int8 -> CountOf Bool -> Int8
rotateR Int8
w (CountOf Int
i) = Int8
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Int8 -> Int8
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Int8 -> CountOf Bool
popCount (I8# Int8#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
x#))))
countLeadingZeros :: Int8 -> CountOf Bool
countLeadingZeros (I8# Int8#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
w#))))
countTrailingZeros :: Int8 -> CountOf Bool
countTrailingZeros (I8# Int8#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
w#))))
instance BitOps Int8 where
.&. :: Int8 -> Int8 -> Int8
(.&.) Int8
a Int8
b = (Int8
a forall a. Bits a => a -> a -> a
OldBits..&. Int8
b)
.|. :: Int8 -> Int8 -> Int8
(.|.) Int8
a Int8
b = (Int8
a forall a. Bits a => a -> a -> a
OldBits..|. Int8
b)
.^. :: Int8 -> Int8 -> Int8
(.^.) Int8
a Int8
b = (Int8
a forall a. Bits a => a -> a -> a
`OldBits.xor` Int8
b)
.<<. :: Int8 -> CountOf Bool -> Int8
(.<<.) Int8
a (CountOf Int
w) = (Int8
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Int8 -> CountOf Bool -> Int8
(.>>.) Int8
a (CountOf Int
w) = (Int8
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
instance FiniteBitsOps Int16 where
numberOfBits :: Int16 -> CountOf Bool
numberOfBits Int16
_ = CountOf Bool
16
rotateL :: Int16 -> CountOf Bool -> Int16
rotateL Int16
w (CountOf Int
i) = Int16
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Int16 -> CountOf Bool -> Int16
rotateR Int16
w (CountOf Int
i) = Int16
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Int16 -> Int16
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Int16 -> CountOf Bool
popCount (I16# Int16#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
x#))))
countLeadingZeros :: Int16 -> CountOf Bool
countLeadingZeros (I16# Int16#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
w#))))
countTrailingZeros :: Int16 -> CountOf Bool
countTrailingZeros (I16# Int16#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
w#))))
instance BitOps Int16 where
.&. :: Int16 -> Int16 -> Int16
(.&.) Int16
a Int16
b = (Int16
a forall a. Bits a => a -> a -> a
OldBits..&. Int16
b)
.|. :: Int16 -> Int16 -> Int16
(.|.) Int16
a Int16
b = (Int16
a forall a. Bits a => a -> a -> a
OldBits..|. Int16
b)
.^. :: Int16 -> Int16 -> Int16
(.^.) Int16
a Int16
b = (Int16
a forall a. Bits a => a -> a -> a
`OldBits.xor` Int16
b)
.<<. :: Int16 -> CountOf Bool -> Int16
(.<<.) Int16
a (CountOf Int
w) = (Int16
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Int16 -> CountOf Bool -> Int16
(.>>.) Int16
a (CountOf Int
w) = (Int16
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
instance FiniteBitsOps Int32 where
numberOfBits :: Int32 -> CountOf Bool
numberOfBits Int32
_ = CountOf Bool
32
rotateL :: Int32 -> CountOf Bool -> Int32
rotateL Int32
w (CountOf Int
i) = Int32
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Int32 -> CountOf Bool -> Int32
rotateR Int32
w (CountOf Int
i) = Int32
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Int32 -> Int32
bitFlip = forall a. Bits a => a -> a
OldBits.complement
popCount :: Int32 -> CountOf Bool
popCount (I32# Int32#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
x#))))
countLeadingZeros :: Int32 -> CountOf Bool
countLeadingZeros (I32# Int32#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
w#))))
countTrailingZeros :: Int32 -> CountOf Bool
countTrailingZeros (I32# Int32#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
w#))))
instance BitOps Int32 where
.&. :: Int32 -> Int32 -> Int32
(.&.) Int32
a Int32
b = (Int32
a forall a. Bits a => a -> a -> a
OldBits..&. Int32
b)
.|. :: Int32 -> Int32 -> Int32
(.|.) Int32
a Int32
b = (Int32
a forall a. Bits a => a -> a -> a
OldBits..|. Int32
b)
.^. :: Int32 -> Int32 -> Int32
(.^.) Int32
a Int32
b = (Int32
a forall a. Bits a => a -> a -> a
`OldBits.xor` Int32
b)
.<<. :: Int32 -> CountOf Bool -> Int32
(.<<.) Int32
a (CountOf Int
w) = (Int32
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Int32 -> CountOf Bool -> Int32
(.>>.) Int32
a (CountOf Int
w) = (Int32
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
#if WORD_SIZE_IN_BITS == 64
instance FiniteBitsOps Int64 where
numberOfBits :: Int64 -> CountOf Bool
numberOfBits Int64
_ = CountOf Bool
64
rotateL :: Int64 -> CountOf Bool -> Int64
rotateL Int64
w (CountOf Int
i) = Int64
w forall a. Bits a => a -> Int -> a
`OldBits.rotateL` Int
i
rotateR :: Int64 -> CountOf Bool -> Int64
rotateR Int64
w (CountOf Int
i) = Int64
w forall a. Bits a => a -> Int -> a
`OldBits.rotateR` Int
i
bitFlip :: Int64 -> Int64
bitFlip = forall a. Bits a => a -> a
OldBits.complement
#if __GLASGOW_HASKELL__ >= 904
popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (wordToWord64# (int2Word# (int64ToInt# x#)))))
countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (wordToWord64# (int2Word# (int64ToInt# w#)))))
countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (wordToWord64# (int2Word# (int64ToInt# w#)))))
#else
popCount :: Int64 -> CountOf Bool
popCount (I64# Int#
x#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
popCnt64# (Int# -> Word#
int2Word# Int#
x#)))
countLeadingZeros :: Int64 -> CountOf Bool
countLeadingZeros (I64# Int#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
clz64# (Int# -> Word#
int2Word# Int#
w#)))
countTrailingZeros :: Int64 -> CountOf Bool
countTrailingZeros (I64# Int#
w#) = forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ Word -> Int
wordToInt (Word# -> Word
W# (Word# -> Word#
ctz64# (Int# -> Word#
int2Word# Int#
w#)))
#endif
instance BitOps Int64 where
.&. :: Int64 -> Int64 -> Int64
(.&.) Int64
a Int64
b = (Int64
a forall a. Bits a => a -> a -> a
OldBits..&. Int64
b)
.|. :: Int64 -> Int64 -> Int64
(.|.) Int64
a Int64
b = (Int64
a forall a. Bits a => a -> a -> a
OldBits..|. Int64
b)
.^. :: Int64 -> Int64 -> Int64
(.^.) Int64
a Int64
b = (Int64
a forall a. Bits a => a -> a -> a
`OldBits.xor` Int64
b)
.<<. :: Int64 -> CountOf Bool -> Int64
(.<<.) Int64
a (CountOf Int
w) = (Int64
a forall a. Bits a => a -> Int -> a
`OldBits.shiftL` Int
w)
.>>. :: Int64 -> CountOf Bool -> Int64
(.>>.) Int64
a (CountOf Int
w) = (Int64
a forall a. Bits a => a -> Int -> a
`OldBits.shiftR` Int
w)
#else
instance FiniteBitsOps Int64 where
numberOfBits _ = 64
rotateL w (CountOf i) = w `OldBits.rotateL` i
rotateR w (CountOf i) = w `OldBits.rotateR` i
bitFlip = OldBits.complement
popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int64ToWord64# x#)))
countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int64ToWord64# w#)))
countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int64ToWord64# w#)))
instance BitOps Int64 where
(.&.) a b = (a OldBits..&. b)
(.|.) a b = (a OldBits..|. b)
(.^.) a b = (a `OldBits.xor` b)
(.<<.) a (CountOf w) = (a `OldBits.shiftL` w)
(.>>.) a (CountOf w) = (a `OldBits.shiftR` w)
#endif