-----------------------------------------------------------------------------
-- |
-- Module      :  Data.BitVector.LittleEndian
-- Copyright   :  (c) Alex Washburn 2018
-- License     :  BSD-style
--
-- Maintainer  :  github@recursion.ninja
-- Stability   :  provisional
-- Portability :  portable
--
-- A bit vector similar to @Data.BitVector@ from the
-- <https://hackage.haskell.org/package/bv bv>, however the endianness is
-- reversed. This module defines /little-endian/ pseudo–size-polymorphic
-- bit vectors.
--
-- Little-endian bit vectors are isomorphic to a @[Bool]@ with the /least/
-- significant bit at the head of the list and the /most/ significant bit at the
-- end of the list. Consequently, the endianness of a bit vector affects the semantics of the
-- following typeclasses:
--
--   * 'Bits'
--   * 'FiniteBits'
--   * 'Semigroup'
--   * 'Monoid'
--   * 'MonoAdjustable'
--   * 'MonoIndexable'
--   * 'MonoKeyed'
--   * 'MonoLookup'
--   * 'MonoFoldable'
--   * 'MonoFoldableWithKey'
--   * 'MonoTraversable'
--   * 'MonoTraversableWithKey'
--   * 'MonoZipWithKey'
--
-- For an implementation of bit vectors which are isomorphic to a @[Bool]@ with the /most/
-- significant bit at the head of the list and the /least/ significant bit at the
-- end of the list, use the
-- <https://hackage.haskell.org/package/bv bv> package.
--
-- This module does /not/ define numeric instances for 'BitVector'. This is
-- intentional! To interact with a bit vector as an 'Integral' value,
-- convert the 'BitVector' using either 'toSignedNumber' or 'toUnsignedNumber'.
--
-- This module defines 'rank' and 'select' operations for 'BitVector' as a
-- <https://en.wikipedia.org/wiki/Succinct_data_structure succinct data structure>.
-- These operations are not /o(1)/ so 'BitVector' is not a /true/ succinct data
-- structure. However, it could potentially be extend to support this in the
-- future.
-----------------------------------------------------------------------------

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE MagicHash          #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE Trustworthy        #-}
{-# LANGUAGE TypeFamilies       #-}

module Data.BitVector.LittleEndian
  ( BitVector()
  -- * Bit-stream conversion
  , fromBits
  , toBits
  -- * Numeric conversion
  , fromNumber
  , toSignedNumber
  , toUnsignedNumber
  -- * Queries
  , dimension
  , isZeroVector
  , subRange
  -- * Rank / Select
  , rank
  , select
  ) where


import Control.DeepSeq
import Data.Bits
import Data.Data
import Data.Foldable
import Data.Hashable
import Data.Key
import Data.List.NonEmpty        (NonEmpty(..))
import Data.Maybe
import Data.Monoid               ()
import Data.MonoTraversable
import Data.MonoTraversable.Keys
import Data.Ord
import Data.Primitive.ByteArray
import Data.Semigroup
import GHC.Exts
import GHC.Generics
import GHC.Integer.GMP.Internals
import GHC.Integer.Logarithms
import GHC.Natural
import Test.QuickCheck           (Arbitrary(..), CoArbitrary(..), NonNegative(..), choose, suchThat, variant)
import TextShow                  (TextShow(showb))


-- |
-- A little-endian bit vector of non-negative dimension.
data  BitVector
    = BV
    { BitVector -> Word
dim :: {-# UNPACK #-} !Word -- ^ The /dimension/ of a bit vector.
    , BitVector -> Natural
nat :: !Natural             -- ^ The value of a bit vector, as a natural number.
    } deriving
#ifdef MIN_VERSION_GLASGOW_HASKELL
#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
         ( Data             -- ^ @since 0.1.0
         , Generic          -- ^ @since 0.1.0
         , Typeable         -- ^ @since 0.1.0
         )
#else
         ( Data
         , Generic
         , Typeable
         )
#endif
#endif


-- |
-- @since 0.1.0
type instance Element BitVector = Bool


-- |
-- @since 1.0.0
type instance MonoKey BitVector = Word


-- |
-- @since 0.1.0
instance Arbitrary BitVector where

    -- Arbitrary instance distribution weighting:
    --  -  2% = (maxBound :: Word)
    --  -  2% = (maxBound :: Word) + 1
    --  -  8% = all bits on
    --  -  8% = all bits off
    --  - 80% = any bit configuration
    arbitrary :: Gen BitVector
arbitrary = do
        -- 1/25 chance of generating the boundary value at which the natural number
        -- must use different Natural constructors: NatS# & NatJ# 
        Word
n <- (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (0, 25 :: Word)
        case Word
n of
          0 -> Gen BitVector
boundaryValue
          1 -> Gen BitVector
allBitsOn
          2 -> Gen BitVector
allBitsOn
          3 -> Gen BitVector
allBitsOff
          4 -> Gen BitVector
allBitsOff
          _ -> Gen BitVector
anyBitValue
      where
        allBitsOn :: Gen BitVector
allBitsOn     = Maybe Bool -> Gen BitVector
genBitVector (Maybe Bool -> Gen BitVector) -> Maybe Bool -> Gen BitVector
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        allBitsOff :: Gen BitVector
allBitsOff    = Maybe Bool -> Gen BitVector
genBitVector (Maybe Bool -> Gen BitVector) -> Maybe Bool -> Gen BitVector
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
        anyBitValue :: Gen BitVector
anyBitValue   = Maybe Bool -> Gen BitVector
genBitVector   Maybe Bool
forall a. Maybe a
Nothing
        
        boundaryValue :: Gen BitVector
boundaryValue = do
            let wrdVal :: Word
wrdVal = Word
forall a. Bounded a => a
maxBound :: Word
            let dimVal :: Word
dimVal = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Bits a => a -> Int
popCount Word
wrdVal
            let numVal :: Natural
numVal = Word -> Natural
wordToNatural Word
wrdVal
            -- 50/50 change to generate above or below the constructor boundary
            Bool
underBoundary <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
            let (lowerBound :: Word
lowerBound, naturalVal :: Natural
naturalVal)
                  | Bool
underBoundary = (Word
dimVal    , Natural
numVal    )
                  | Bool
otherwise     = (Word
dimVal Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1, Natural
numVal Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ 1)
            Word
widthVal <- (NonNegative Word -> Word
forall a. NonNegative a -> a
getNonNegative (NonNegative Word -> Word) -> Gen (NonNegative Word) -> Gen Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Word)
forall a. Arbitrary a => Gen a
arbitrary) Gen Word -> (Word -> Bool) -> Gen Word
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
lowerBound)
            BitVector -> Gen BitVector
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BitVector -> Gen BitVector) -> BitVector -> Gen BitVector
forall a b. (a -> b) -> a -> b
$ Word -> Natural -> BitVector
BV Word
widthVal Natural
naturalVal

        genBitVector :: Maybe Bool -> Gen BitVector
genBitVector spec :: Maybe Bool
spec = do
            Int
dimVal <- NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Int) -> Gen (NonNegative Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary 
            let upperBound :: Integer
upperBound = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL 1 Int
dimVal
            -- 1/5 chance all bits on or all bits off
            Natural
natVal <- case Maybe Bool
spec of
                        Just False -> Natural -> Gen Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Gen Natural) -> Natural -> Gen Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
intToNat 0
                        Just True  -> Natural -> Gen Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Gen Natural)
-> (Integer -> Natural) -> Integer -> Gen Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
intToNat (Integer -> Gen Natural) -> Integer -> Gen Natural
forall a b. (a -> b) -> a -> b
$ Integer
upperBound Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
                        Nothing    -> (Integer -> Natural) -> Gen Integer -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Natural
intToNat (Gen Integer -> Gen Natural) -> Gen Integer -> Gen Natural
forall a b. (a -> b) -> a -> b
$
                                        (NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> Integer)
-> Gen (NonNegative Integer) -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary) Gen Integer -> (Integer -> Bool) -> Gen Integer
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
upperBound)
            BitVector -> Gen BitVector
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BitVector -> Gen BitVector) -> BitVector -> Gen BitVector
forall a b. (a -> b) -> a -> b
$ Word -> Natural -> BitVector
BV (Int -> Word
forall a. Enum a => Int -> a
toEnum Int
dimVal) Natural
natVal


-- |
-- @since 0.1.0
instance Bits BitVector where

    {-# INLINE (.&.) #-}
    (BV w1 :: Word
w1 a :: Natural
a) .&. :: BitVector -> BitVector -> BitVector
.&. (BV w2 :: Word
w2 b :: Natural
b) = Word -> Natural -> BitVector
BV (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
w1 Word
w2) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
a Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
b

    {-# INLINE (.|.) #-}
    (BV w1 :: Word
w1 a :: Natural
a) .|. :: BitVector -> BitVector -> BitVector
.|. (BV w2 :: Word
w2 b :: Natural
b) = Word -> Natural -> BitVector
BV (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
w1 Word
w2) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
a Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. Natural
b

    {-# INLINE xor #-}
    (BV w1 :: Word
w1 a :: Natural
a) xor :: BitVector -> BitVector -> BitVector
`xor` (BV w2 :: Word
w2 b :: Natural
b) = Word -> Natural -> BitVector
BV (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
w1 Word
w2) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
a Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
`xor` Natural
b

    {-# INLINE complement #-}
    complement :: BitVector -> BitVector
complement (BV w :: Word
w n :: Natural
n) = Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
n

    {-# INLINE zeroBits #-}
    zeroBits :: BitVector
zeroBits = Word -> Natural -> BitVector
BV 0 0

    {-# INLINE bit #-}
    bit :: Int -> BitVector
bit i :: Int
i = Word -> Natural -> BitVector
BV (Word -> Word
forall a. Enum a => a -> a
succ (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i)  (Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 Int
i)

    {-# INLINE clearBit #-}
    -- We do this more complicated operation rather than call 'clearBit'
    -- because it is undefined for Natural in base < 4.10.0.0
    clearBit :: BitVector -> Int -> BitVector
clearBit bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) i :: Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w = BitVector
bv
      | Bool
otherwise =
        let !allBits :: Natural
allBits = Natural -> Natural
forall a. Enum a => a -> a
pred (Natural -> Natural) -> (Int -> Natural) -> Int -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
            !mask :: Natural
mask    = Int -> Natural
forall a. Bits a => Int -> a
bit Int
i Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
`xor` Natural
allBits
        in  Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
mask

    {-# INLINE setBit #-}
    setBit :: BitVector -> Int -> BitVector
setBit bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) i :: Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = BitVector
bv
      | Bool
otherwise = Word -> Natural -> BitVector
BV (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
w Word
j) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`setBit` Int
i
      where
        !j :: Word
j = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1

    {-# INLINE testBit #-}
    testBit :: BitVector -> Int -> Bool
testBit (BV w :: Word
w n :: Natural
n) i :: Int
i = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
w Bool -> Bool -> Bool
&& Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i

    bitSize :: BitVector -> Int
bitSize (BV w :: Word
w _) = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w

    {-# INLINE bitSizeMaybe #-}
    bitSizeMaybe :: BitVector -> Maybe Int
bitSizeMaybe (BV w :: Word
w _) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w

    {-# INLINE isSigned #-}
    isSigned :: BitVector -> Bool
isSigned = Bool -> BitVector -> Bool
forall a b. a -> b -> a
const Bool
False

    {-# INLINE shiftL #-}
    shiftL :: BitVector -> Int -> BitVector
shiftL (BV w :: Word
w n :: Natural
n) k :: Int
k
      | Int -> Word
forall a. Enum a => Int -> a
toEnum Int
k Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
w = Word -> Natural -> BitVector
BV Word
w 0
      | Bool
otherwise    = Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL Natural
n Int
k Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural -> Natural
forall a. Enum a => a -> a
pred (Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w))

    {-# INLINE shiftR #-}
    shiftR :: BitVector -> Int -> BitVector
shiftR (BV w :: Word
w n :: Natural
n) k :: Int
k
      | Int -> Word
forall a. Enum a => Int -> a
toEnum Int
k Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
w = Word -> Natural -> BitVector
BV Word
w 0
      | Bool
otherwise    = Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftR Natural
n Int
k

    {-# INLINE rotateL #-}
    rotateL :: BitVector -> Int -> BitVector
rotateL bv :: BitVector
bv          0 = BitVector
bv
    rotateL bv :: BitVector
bv@(BV 0 _) _ = BitVector
bv
    rotateL bv :: BitVector
bv@(BV 1 _) _ = BitVector
bv
    rotateL bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) k :: Int
k
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  0    = BitVector
bv
      | Word
j Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w    = Int -> BitVector
go (Int -> BitVector) -> (Word -> Int) -> Word -> BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> BitVector) -> Word -> BitVector
forall a b. (a -> b) -> a -> b
$ Word
j Word -> Word -> Word
forall a. Integral a => a -> a -> a
`mod` Word
w
      | Bool
otherwise = Int -> BitVector
go Int
k
      where
        !j :: Word
j     = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
k
        go :: Int -> BitVector
go  0  = BitVector
bv
        go !Int
i  = Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
h Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
l
          where
            !v :: Int
v = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
            !d :: Int
d = Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
            !m :: Natural
m = Natural -> Natural
forall a. Enum a => a -> a
pred (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 Int
d
            !l :: Natural
l = Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftR` Int
d
            !h :: Natural
h = (Natural
n Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
m) Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Int
i

    {-# INLINE rotateR #-}
    rotateR :: BitVector -> Int -> BitVector
rotateR bv :: BitVector
bv          0 = BitVector
bv
    rotateR bv :: BitVector
bv@(BV 0 _) _ = BitVector
bv
    rotateR bv :: BitVector
bv@(BV 1 _) _ = BitVector
bv
    rotateR bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) k :: Int
k
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  0    = BitVector
bv
      | Word
j Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w    = Int -> BitVector
go (Int -> BitVector) -> (Word -> Int) -> Word -> BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> BitVector) -> Word -> BitVector
forall a b. (a -> b) -> a -> b
$ Word
j Word -> Word -> Word
forall a. Integral a => a -> a -> a
`mod` Word
w
      | Bool
otherwise = Int -> BitVector
go Int
k
      where
        !j :: Word
j     = Int -> Word
forall a. Enum a => Int -> a
toEnum Int
k
        go :: Int -> BitVector
go  0  = BitVector
bv
        go !Int
i  = Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
h Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
l
          where
            !v :: Int
v = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
            !d :: Int
d = Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
            !m :: Natural
m = Natural -> Natural
forall a. Enum a => a -> a
pred (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL 1 Int
i
            !l :: Natural
l = Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftR` Int
i
            !h :: Natural
h = (Natural
n Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
m) Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Int
d

    {-# INLINE popCount #-}
    popCount :: BitVector -> Int
popCount = Natural -> Int
forall a. Bits a => a -> Int
popCount (Natural -> Int) -> (BitVector -> Natural) -> BitVector -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Natural
nat


-- |
-- @since 0.1.0
instance CoArbitrary BitVector where

    coarbitrary :: BitVector -> Gen b -> Gen b
coarbitrary bv :: BitVector
bv = Word -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (BitVector -> Word
dimension BitVector
bv)


-- |
-- @since 0.1.0
instance Eq BitVector where

    {-# INLINE (==) #-}
    == :: BitVector -> BitVector -> Bool
(==) (BV w1 :: Word
w1 m :: Natural
m) (BV w2 :: Word
w2 n :: Natural
n) = Word
w1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
w2 Bool -> Bool -> Bool
&& Natural -> BigNat
naturalToBigNat Natural
m BigNat -> BigNat -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> BigNat
naturalToBigNat Natural
n
      where
        naturalToBigNat :: Natural -> BigNat
naturalToBigNat (NatS# w :: GmpLimb#
w ) = GmpLimb# -> BigNat
wordToBigNat GmpLimb#
w
        naturalToBigNat (NatJ# bn :: BigNat
bn) = BigNat
bn


-- |
-- @since 0.1.0
instance FiniteBits BitVector where

    {-# INLINE finiteBitSize #-}
    finiteBitSize :: BitVector -> Int
finiteBitSize = Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> Int) -> (BitVector -> Word) -> BitVector -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Word
dim

    {-# INLINE countTrailingZeros #-}
    countTrailingZeros :: BitVector -> Int
countTrailingZeros (BV w :: Word
w n :: Natural
n) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastSetBit Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
      where
        lastSetBit :: Int
lastSetBit = Int# -> Int
I# (Integer -> Int#
integerLog2# (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n))

    {-# INLINE countLeadingZeros #-}
    countLeadingZeros :: BitVector -> Int
countLeadingZeros (BV w :: Word
w      0) = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
    countLeadingZeros (BV w :: Word
w natVal :: Natural
natVal) =
        case Natural
natVal of
          NatS#      v :: GmpLimb#
v  -> Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
iMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. GmpLimb# -> Word
W# GmpLimb#
v
          NatJ# (BN# v :: ByteArray#
v) -> ByteArray -> Int
f (ByteArray -> Int) -> ByteArray -> Int
forall a b. (a -> b) -> a -> b
$ ByteArray# -> ByteArray
ByteArray ByteArray#
v
      where
        iMask :: Word
iMask = Word -> Word
forall a. Bits a => a -> a
complement Word
forall a. Bits a => a
zeroBits Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1)
        !x :: Int
x = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w

        f :: ByteArray -> Int
        f :: ByteArray -> Int
f byteArr :: ByteArray
byteArr = Int -> Int
g 0
          where
            (q :: Int
q, r :: Int
r) = Int
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
bitsInWord
            wMask :: Word
wMask  = Word -> Word
forall a. Bits a => a -> a
complement Word
forall a. Bits a => a
zeroBits Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (2 Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
r Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) :: Word

            g :: Int -> Int
            g :: Int -> Int
g !Int
i
              | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
q = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
wMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
value
              | Bool
otherwise =
                  let !v :: Int
v = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
value
                  in  if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
bitsInWord
                      then Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                      else Int
v
              where
                value :: Word
                value :: Word
value = ByteArray
byteArr ByteArray -> Int -> Word
forall a. Prim a => ByteArray -> Int -> a
`indexByteArray` Int
i


-- |
-- @since 0.1.0
instance Hashable BitVector where

    hash :: BitVector -> Int
hash (BV w :: Word
w n :: Natural
n) = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Natural -> Int
forall a. Hashable a => a -> Int
hash Natural
n

    hashWithSalt :: Int -> BitVector -> Int
hashWithSalt salt :: Int
salt bv :: BitVector
bv = Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` BitVector -> Int
forall a. Hashable a => a -> Int
hash BitVector
bv


-- |
-- @since 0.1.0
instance Monoid BitVector where

    {-# INLINE mappend #-}
    mappend :: BitVector -> BitVector -> BitVector
mappend = BitVector -> BitVector -> BitVector
forall a. Semigroup a => a -> a -> a
(<>)

    {-# INLINE mconcat #-}
    mconcat :: [BitVector] -> BitVector
mconcat bs :: [BitVector]
bs =
        case [BitVector]
bs of
          []   -> BitVector
forall a. Monoid a => a
mempty
          x :: BitVector
x:xs :: [BitVector]
xs -> NonEmpty BitVector -> BitVector
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty BitVector -> BitVector)
-> NonEmpty BitVector -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector
xBitVector -> [BitVector] -> NonEmpty BitVector
forall a. a -> [a] -> NonEmpty a
:|[BitVector]
xs

    {-# INLINE mempty #-}
    mempty :: BitVector
mempty = Word -> Natural -> BitVector
BV 0 0


-- |
-- @since 1.0.0
instance MonoAdjustable BitVector where

    -- | /O(1)/
    {-# INLINE oadjust #-}
    oadjust :: (Element BitVector -> Element BitVector)
-> MonoKey BitVector -> BitVector -> BitVector
oadjust f :: Element BitVector -> Element BitVector
f k :: MonoKey BitVector
k bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n)
      | Word
MonoKey BitVector
k Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w    = BitVector
bv
      | Bool
v Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
Element BitVector
b    = BitVector
bv
      | Bool
otherwise = BitVector
bv BitVector -> Int -> BitVector
forall a. Bits a => a -> Int -> a
`complementBit` Int
i
      where
        !i :: Int
i = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
MonoKey BitVector
k
        !v :: Bool
v = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i
        !b :: Element BitVector
b = Element BitVector -> Element BitVector
f Bool
Element BitVector
v

    -- | /O(1)/
    {-# INLINE oreplace #-}
    oreplace :: MonoKey BitVector -> Element BitVector -> BitVector -> BitVector
oreplace k :: MonoKey BitVector
k v :: Element BitVector
v bv :: BitVector
bv@(BV w :: Word
w _)
      | Word
MonoKey BitVector
k Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w    = BitVector
bv
      | Bool
Element BitVector
v         = BitVector
bv   BitVector -> Int -> BitVector
forall a. Bits a => a -> Int -> a
`setBit` Int
i
      | Bool
otherwise = BitVector
bv BitVector -> Int -> BitVector
forall a. Bits a => a -> Int -> a
`clearBit` Int
i
      where
        !i :: Int
i = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
MonoKey BitVector
k


-- |
-- @since 0.1.0
instance MonoFoldable BitVector where

    {-# INLINE ofoldMap #-}
    ofoldMap :: (Element BitVector -> m) -> BitVector -> m
ofoldMap f :: Element BitVector -> m
f (BV w :: Word
w n :: Natural
n) = Int -> m
go Int
m
      where
        !m :: Int
m = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
        go :: Int -> m
go  0 = m
forall a. Monoid a => a
mempty
        go !Int
c = let !i :: Int
i = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                    !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                    !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i
                in  Element BitVector -> m
f Bool
Element BitVector
b m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Int -> m
go Int
j
                      
    {-# INLINE ofoldr #-}
    ofoldr :: (Element BitVector -> b -> b) -> b -> BitVector -> b
ofoldr f :: Element BitVector -> b -> b
f e :: b
e (BV w :: Word
w n :: Natural
n) =
      let !m :: Int
m = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
          go :: Int -> b -> b
go  0 acc :: b
acc = b
acc
          go !Int
c acc :: b
acc = let !i :: Int
i = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                          !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                          !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i
                      in  Element BitVector -> b -> b
f Bool
Element BitVector
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Int -> b -> b
go Int
j b
acc
      in  Int -> b -> b
go Int
m b
e

    {-# INLINE ofoldl' #-}
    ofoldl' :: (a -> Element BitVector -> a) -> a -> BitVector -> a
ofoldl' f :: a -> Element BitVector -> a
f e :: a
e (BV w :: Word
w n :: Natural
n) = Int -> a -> a
go Int
m a
e
      where
        !m :: Int
m = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
        go :: Int -> a -> a
go  0 acc :: a
acc = a
acc
        go !Int
c acc :: a
acc = let !i :: Int
i = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                        !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                        !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i
                        !a :: a
a = a -> Element BitVector -> a
f a
acc Bool
Element BitVector
b
                    in  Int -> a -> a
go Int
j a
a

    {-# INLINE otoList #-}
    otoList :: BitVector -> [Element BitVector]
otoList = BitVector -> [Bool]
BitVector -> [Element BitVector]
toBits

    -- | /O(1)/
    {-# INLINE oall #-}
    oall :: (Element BitVector -> Bool) -> BitVector -> Bool
oall _ (BV 0 _) = Bool
True
    oall f :: Element BitVector -> Bool
f (BV w :: Word
w n :: Natural
n) =
        case (Element BitVector -> Bool
f Bool
Element BitVector
False, Element BitVector -> Bool
f Bool
Element BitVector
True) of
          (False, False) -> Bool
False
          (True , True ) -> Bool
True
          (False, True ) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
          (True , False) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== 0

    -- | /O(1)/
    {-# INLINE oany #-}
    oany :: (Element BitVector -> Bool) -> BitVector -> Bool
oany _ (BV 0 _) = Bool
False
    oany f :: Element BitVector -> Bool
f (BV w :: Word
w n :: Natural
n) =
        case (Element BitVector -> Bool
f Bool
Element BitVector
False, Element BitVector -> Bool
f Bool
Element BitVector
True) of
          (False, False) -> Bool
False
          (True , True ) -> Bool
True
          (False, True ) -> Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
          (True , False) -> Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1

    -- | /O(1)/
    {-# INLINE onull #-}
    onull :: BitVector -> Bool
onull   = (Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Word -> Bool) -> (BitVector -> Word) -> BitVector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Word
dim

    -- | /O(1)/
    {-# INLINE olength #-}
    olength :: BitVector -> Int
olength = Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> Int) -> (BitVector -> Word) -> BitVector -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Word
dim

    -- | /O(1)/
    {-# INLINE olength64 #-}
    olength64 :: BitVector -> Int64
olength64 = Int -> Int64
forall a. Enum a => Int -> a
toEnum (Int -> Int64) -> (BitVector -> Int) -> BitVector -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Int
forall mono. MonoFoldable mono => mono -> Int
olength

    {-# INLINE otraverse_ #-}
    otraverse_ :: (Element BitVector -> f b) -> BitVector -> f ()
otraverse_ f :: Element BitVector -> f b
f (BV w :: Word
w n :: Natural
n) = Int -> f ()
go (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) 
      where
        go :: Int -> f ()
go 0 = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        go !Int
c = let !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                    !a :: f b
a = Element BitVector -> f b
f (Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
j)
                in  f b
a f b -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> f ()
go Int
j


    {-# INLINE ofoldlM #-}
    ofoldlM :: (a -> Element BitVector -> m a) -> a -> BitVector -> m a
ofoldlM f :: a -> Element BitVector -> m a
f e :: a
e (BV w :: Word
w n :: Natural
n) = Int -> a -> m a
go (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) a
e
      where
        go :: Int -> a -> m a
go  0 acc :: a
acc = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
acc
        go !Int
c acc :: a
acc = let !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                        !x :: m a
x = a -> Element BitVector -> m a
f a
acc (Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
j)
                    in  m a
x m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> m a
go Int
j
        
    {-# INLINE ofoldMap1Ex #-}
    ofoldMap1Ex :: (Element BitVector -> m) -> BitVector -> m
ofoldMap1Ex _ (BV 0 _) = [Char] -> m
forall a. HasCallStack => [Char] -> a
Prelude.error "Data.MonoTraversable.ofoldMap1Ex on an empty BitVector!"
    ofoldMap1Ex f :: Element BitVector -> m
f (BV w :: Word
w n :: Natural
n) = Int -> m
go 0
      where
        !m :: Int
m    = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
        go :: Int -> m
go !Int
c
          | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 = Element BitVector -> m
f (Element BitVector -> m) -> Element BitVector -> m
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
c
          | Bool
otherwise  = let !j :: Int
j = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
                             !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
c
                         in  Element BitVector -> m
f Bool
Element BitVector
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> m
go Int
j

    -- | /O(1)/
    {-# INLINE ofoldr1Ex #-}
    ofoldr1Ex :: (Element BitVector -> Element BitVector -> Element BitVector)
-> BitVector -> Element BitVector
ofoldr1Ex _    (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
Prelude.error "Data.MonoTraversable.ofoldr1Ex on an empty BitVector!"
    ofoldr1Ex _    (BV 1 n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
    ofoldr1Ex f :: Element BitVector -> Element BitVector -> Element BitVector
f bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) =
        -- See the following entry for explanation:
        -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators
        --
        -- cases of f p q
        case (Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
False, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
False) of
          -- Contradiction (Const False)
          (False, False, False, False) -> Bool
Element BitVector
False
          -- Logical NOR
          (False, False, False, True ) -> let !lzs :: Word
lzs = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ BitVector -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros BitVector
bv
                                          in  if (Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
lzs) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                                              then Word -> Bool
forall a. Integral a => a -> Bool
even Word
lzs
                                              else Word -> Bool
forall a. Integral a => a -> Bool
odd  Word
lzs
          -- Converse non-implication
          --   Only True when of the form <0+1>
          (False, False, True , False) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
          -- NOT p
          (False, False, True , True ) -> Bool -> Bool
not (Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 0)
          -- Logical non-implication
          --   Only True when the number of leading ones is even
          (False, True , False, False) -> let !los :: Int
los = BitVector -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (BitVector -> Int) -> BitVector -> Int
forall a b. (a -> b) -> a -> b
$ BitVector -> BitVector
forall a. Bits a => a -> a
complement BitVector
bv
                                          in  Int -> Bool
forall a. Integral a => a -> Bool
odd Int
los
          -- NOT q
          (False, True , False, True ) -> let !v :: Bool
v = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                                          in  if Word -> Bool
forall a. Integral a => a -> Bool
even Word
w then Bool -> Bool
not Bool
v else Bool
Element BitVector
v
          -- Logical XOR
          (False, True , True , False) -> Int -> Element BitVector
forall a. Integral a => a -> Bool
odd (Int -> Element BitVector) -> Int -> Element BitVector
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Bits a => a -> Int
popCount Natural
n
          -- Logical NAND
          (False, True , True , True ) -> let !los :: Int
los = BitVector -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (BitVector -> Int) -> BitVector -> Int
forall a b. (a -> b) -> a -> b
$ BitVector -> BitVector
forall a. Bits a => a -> a
complement BitVector
bv
                                              !x :: Natural
x   = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
                                              !y :: Natural
y   = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w    ) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
                                          in  if Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
x Bool -> Bool -> Bool
|| Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
y
                                              then Int -> Bool
forall a. Integral a => a -> Bool
odd  Int
los
                                              else Int -> Bool
forall a. Integral a => a -> Bool
even Int
los
          -- Logical AND
          (True , False, False, False) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
          -- Logical XNOR
          (True , False, False, True ) -> let !pc :: Int
pc = Natural -> Int
forall a. Bits a => a -> Int
popCount Natural
n
                                          in  if   Word -> Bool
forall a. Integral a => a -> Bool
even Word
w
                                              then Int -> Bool
forall a. Integral a => a -> Bool
even Int
pc
                                              else Int -> Bool
forall a. Integral a => a -> Bool
odd  Int
pc
          -- Const q
          (True , False, True , False) -> Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
          -- Logical implication
          --   only False when of the form <1+0>
          (True , False, True , True ) -> let !i :: Int
i = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                                          in  Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Natural
forall a. Bits a => Int -> a
bit Int
i Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
          -- Const p
          (True , True , False, False) -> Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 0
          -- Converse implication
          (True , True , False, True ) -> Int -> Element BitVector
forall a. Integral a => a -> Bool
even (Int -> Element BitVector) -> Int -> Element BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros BitVector
bv
          -- Logical OR
          (True , True , True , False) -> Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
          -- Constant True
          (True , True , True , True ) -> Bool
Element BitVector
True

    -- | /O(n)/
    {-# INLINE ofoldl1Ex' #-}
    ofoldl1Ex' :: (Element BitVector -> Element BitVector -> Element BitVector)
-> BitVector -> Element BitVector
ofoldl1Ex' _    (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
Prelude.error "Data.MonoTraversable.ofoldl1Ex' on an empty BitVector!"
    ofoldl1Ex' _    (BV 1 n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
    ofoldl1Ex' f :: Element BitVector -> Element BitVector -> Element BitVector
f bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) =
        -- See the following entry for explanation:
        -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators
        --
        -- cases of f p q
        case (Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
False, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
False) of
          -- Contradiction (Const False)
          (False, False, False, False) -> Bool
Element BitVector
False
          -- Logical NOR
          (False, False, False, True ) -> let !tzs :: Word
tzs = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ BitVector -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros BitVector
bv
                                          in  if (Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
tzs) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                                              then Word -> Bool
forall a. Integral a => a -> Bool
even Word
tzs
                                              else Word -> Bool
forall a. Integral a => a -> Bool
odd  Word
tzs
          -- Converse non-implication
          (False, False, True , False) -> let !tzs :: Int
tzs = BitVector -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (BitVector -> Int) -> BitVector -> Int
forall a b. (a -> b) -> a -> b
$ BitVector -> BitVector
forall a. Bits a => a -> a
complement BitVector
bv
                                          in  Int -> Bool
forall a. Integral a => a -> Bool
odd Int
tzs
          -- NOT p
          (False, False, True , True ) -> Word -> Bool
forall a. Integral a => a -> Bool
even Word
w Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> Bool
forall a. Integral a => a -> Bool
even Natural
n
          -- Logical non-implication
          (False, True , False, False) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== 1
          -- NOT q
          (False, True , False, True ) -> Bool -> Bool
Bool -> Element BitVector
not (Bool -> Element BitVector) -> Bool -> Element BitVector
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
          -- Logical XOR
          (False, True , True , False) -> Int -> Element BitVector
forall a. Integral a => a -> Bool
odd  (Int -> Element BitVector) -> Int -> Element BitVector
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Bits a => a -> Int
popCount Natural
n
          -- Logical NAND
          (False, True , True , True ) -> let !tos :: Int
tos = BitVector -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (BitVector -> Int) -> BitVector -> Int
forall a b. (a -> b) -> a -> b
$ BitVector -> BitVector
forall a. Bits a => a -> a
complement BitVector
bv
                                              !x :: Natural
x   = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
                                              !y :: Natural
y   = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 2
                                          in  if Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
x Bool -> Bool -> Bool
|| Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
y
                                              then Int -> Bool
forall a. Integral a => a -> Bool
odd  Int
tos
                                              else Int -> Bool
forall a. Integral a => a -> Bool
even Int
tos
          -- Logical AND
          (True , False, False, False) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
          -- Logical XNOR
          (True , False, False, True ) -> let !pc :: Int
pc = Natural -> Int
forall a. Bits a => a -> Int
popCount Natural
n
                                          in  if   Word -> Bool
forall a. Integral a => a -> Bool
even Word
w
                                              then Int -> Bool
forall a. Integral a => a -> Bool
even Int
pc
                                              else Int -> Bool
forall a. Integral a => a -> Bool
odd  Int
pc
          -- Const q
          (True , False, True , False) -> Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
          -- Logical implication
          (True , False, True , True ) -> Int -> Element BitVector
forall a. Integral a => a -> Bool
even (Int -> Element BitVector) -> Int -> Element BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros BitVector
bv
          -- Const p
          (True , True , False, False) -> Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 0
          -- Converse implication
          --    only False when of the form <01+>
          (True , True , False, True ) -> Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 2
          -- Logical OR
          (True , True , True , False) -> Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
          -- Constant True
          (True , True , True , True ) -> Bool
Element BitVector
True

    -- | /O(1)/
    {-# INLINE headEx #-}
    headEx :: BitVector -> Element BitVector
headEx (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "Call to Data.MonoFoldable.headEx on an empty BitVector!"
    headEx (BV _ n :: Natural
n) = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 0

    -- | /O(1)/
    {-# INLINE lastEx #-}
    lastEx :: BitVector -> Element BitVector
lastEx (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "Call to Data.MonoFoldable.lastEx on an empty BitVector!"
    lastEx (BV w :: Word
w n :: Natural
n) = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)

    -- | /O(n)/
    {-# INLINE maximumByEx #-}
    maximumByEx :: (Element BitVector -> Element BitVector -> Ordering)
-> BitVector -> Element BitVector
maximumByEx _ (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "Call to Data.MonoFoldable.maximumByEx on an empty BitVector!"
    maximumByEx _ (BV 1 n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
    maximumByEx f :: Element BitVector -> Element BitVector -> Ordering
f  bv :: BitVector
bv      = (Bool -> Bool -> Ordering) -> [Bool] -> Bool
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Bool -> Bool -> Ordering
Element BitVector -> Element BitVector -> Ordering
f ([Bool] -> Element BitVector) -> [Bool] -> Element BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> [Bool]
toBits BitVector
bv

    -- | /O(n)/
    {-# INLINE minimumByEx #-}
    minimumByEx :: (Element BitVector -> Element BitVector -> Ordering)
-> BitVector -> Element BitVector
minimumByEx _ (BV 0 _) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "Call to Data.MonoFoldable.minimumByEx on an empty BitVector!"
    minimumByEx _ (BV 1 n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
    minimumByEx f :: Element BitVector -> Element BitVector -> Ordering
f  bv :: BitVector
bv      = (Bool -> Bool -> Ordering) -> [Bool] -> Bool
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Bool -> Bool -> Ordering
Element BitVector -> Element BitVector -> Ordering
f ([Bool] -> Element BitVector) -> [Bool] -> Element BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> [Bool]
toBits BitVector
bv

    -- | /O(1)/
    {-# INLINE oelem #-}
    oelem :: Element BitVector -> BitVector -> Bool
oelem _     (BV 0 _) = Bool
False
    oelem True  (BV _ n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> 0
    oelem False (BV w :: Word
w n :: Natural
n) = Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1

    -- | /O(1)/
    {-# INLINE onotElem #-}
    onotElem :: Element BitVector -> BitVector -> Bool
onotElem e :: Element BitVector
e = Bool -> Bool
not (Bool -> Bool) -> (BitVector -> Bool) -> BitVector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element BitVector -> BitVector -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
oelem Element BitVector
e


-- |
-- @since 1.0.0
instance MonoFoldableWithKey BitVector where

    -- | /O(n)/
    {-# INLINE otoKeyedList #-}
    otoKeyedList :: BitVector -> [(MonoKey BitVector, Element BitVector)]
otoKeyedList (BV w :: Word
w n :: Natural
n) = 
      let go :: Word -> [(Word, Bool)]
go  0 = []
          go !Word
c = let !k :: Word
k = Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                      !v :: Bool
v = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                      !i :: Word
i = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                  in  (Word
k, Bool
v) (Word, Bool) -> [(Word, Bool)] -> [(Word, Bool)]
forall a. a -> [a] -> [a]
: Word -> [(Word, Bool)]
go Word
i
      in  Word -> [(Word, Bool)]
go Word
w

    -- | /O(n)/
    {-# INLINE ofoldMapWithKey #-}
    ofoldMapWithKey :: (MonoKey BitVector -> Element BitVector -> m) -> BitVector -> m
ofoldMapWithKey f :: MonoKey BitVector -> Element BitVector -> m
f (BV w :: Word
w n :: Natural
n) =
      let go :: Word -> m
go  0 = m
forall a. Monoid a => a
mempty
          go !Word
c = let !k :: Word
k = Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                      !v :: Bool
v = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                      !i :: Word
i = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                      !m :: m
m = MonoKey BitVector -> Element BitVector -> m
f Word
MonoKey BitVector
k Bool
Element BitVector
v
                  in  m
m m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Word -> m
go Word
i
      in  Word -> m
go Word
w

    -- | /O(n)/
    {-# INLINE ofoldrWithKey #-}
    ofoldrWithKey :: (MonoKey BitVector -> Element BitVector -> a -> a)
-> a -> BitVector -> a
ofoldrWithKey f :: MonoKey BitVector -> Element BitVector -> a -> a
f e :: a
e (BV w :: Word
w n :: Natural
n) =
      let go :: Word -> a -> a
go  0 acc :: a
acc = a
acc
          go !Word
c acc :: a
acc = let !k :: Word
k = Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                          !i :: Word
i = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                          !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                      in  MonoKey BitVector -> Element BitVector -> a -> a
f Word
MonoKey BitVector
k Bool
Element BitVector
b (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Word -> a -> a
go Word
i a
acc
      in  Word -> a -> a
go Word
w a
e

    -- | /O(n)/
    {-# INLINE ofoldlWithKey #-}
    ofoldlWithKey :: (a -> MonoKey BitVector -> Element BitVector -> a)
-> a -> BitVector -> a
ofoldlWithKey f :: a -> MonoKey BitVector -> Element BitVector -> a
f e :: a
e (BV w :: Word
w n :: Natural
n) = Word -> a -> a
go Word
w a
e
      where
        go :: Word -> a -> a
go  0 acc :: a
acc = a
acc
        go !Word
c acc :: a
acc = let !k :: Word
k = Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                        !i :: Word
i = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                        !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                        !a :: a
a = a -> MonoKey BitVector -> Element BitVector -> a
f a
acc Word
MonoKey BitVector
k Bool
Element BitVector
b
                    in  Word -> a -> a
go Word
i a
a


-- |
-- @since 0.1.0
instance MonoFunctor BitVector where

    -- | /O(1)/
    {-# INLINE omap #-}
    omap :: (Element BitVector -> Element BitVector) -> BitVector -> BitVector
omap f :: Element BitVector -> Element BitVector
f bv :: BitVector
bv@(BV w :: Word
w n :: Natural
n) =
        case (Element BitVector -> Element BitVector
f Bool
Element BitVector
False, Element BitVector -> Element BitVector
f Bool
Element BitVector
True) of
          (False, False) -> Word -> Natural -> BitVector
BV Word
w 0
          (True , True ) -> Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
          (False, True ) -> BitVector
bv
          (True , False) -> let !allOnes :: Natural
allOnes = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
                            in  Word -> Natural -> BitVector
BV Word
w (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
`xor` Natural
allOnes


-- |
-- @since 1.0.0
instance MonoIndexable BitVector where

    -- | /O(1)/
    {-# INLINE oindex #-}
    oindex :: BitVector -> MonoKey BitVector -> Element BitVector
oindex bv :: BitVector
bv@(BV w :: Word
w _) i :: MonoKey BitVector
i = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
errorMessage (Maybe Bool -> Element BitVector)
-> Maybe Bool -> Element BitVector
forall a b. (a -> b) -> a -> b
$ MonoKey BitVector
i MonoKey BitVector -> BitVector -> Maybe (Element BitVector)
forall mono.
MonoLookup mono =>
MonoKey mono -> mono -> Maybe (Element mono)
`olookup` BitVector
bv
      where
        errorMessage :: Bool
errorMessage = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
            [ "Data.BitVector.LittleEndian.oindex: "
            , "The index "
            , Word -> [Char]
forall a. Show a => a -> [Char]
show Word
MonoKey BitVector
i
            , " was greater than or equal to the length of the bit vector "
            , Word -> [Char]
forall a. Show a => a -> [Char]
show Word
w
            ] 


-- |
-- @since 1.0.0
instance MonoKeyed BitVector where

    -- | /O(n)/
    {-# INLINE omapWithKey #-}
    omapWithKey :: (MonoKey BitVector -> Element BitVector -> Element BitVector)
-> BitVector -> BitVector
omapWithKey f :: MonoKey BitVector -> Element BitVector -> Element BitVector
f (BV w :: Word
w n :: Natural
n) =
      let go :: Word -> BitVector -> BitVector
go  0 acc :: BitVector
acc = BitVector
acc
          go !Word
c acc :: BitVector
acc = let !k :: Word
k = Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                          !i :: Int
i = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                          !j :: Word
j = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                          !b :: Bool
b = Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i
                          !a :: BitVector
a | MonoKey BitVector -> Element BitVector -> Element BitVector
f Word
MonoKey BitVector
k Bool
Element BitVector
b     = BitVector
acc BitVector -> Int -> BitVector
forall a. Bits a => a -> Int -> a
`setBit` Int
i
                             | Bool
otherwise = BitVector
acc
                      in  Word -> BitVector -> BitVector
go Word
j BitVector
a
      in  Word -> BitVector -> BitVector
go Word
w (BitVector -> BitVector) -> BitVector -> BitVector
forall a b. (a -> b) -> a -> b
$ Word -> Natural -> BitVector
BV Word
w 0


-- |
-- @since 1.0.0
instance MonoLookup BitVector where

    -- | /O(1)/
    {-# INLINE olookup #-}
    olookup :: MonoKey BitVector -> BitVector -> Maybe (Element BitVector)
olookup k :: MonoKey BitVector
k (BV w :: Word
w n :: Natural
n)
      | Word
MonoKey BitVector
k Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
w    = Maybe (Element BitVector)
forall a. Maybe a
Nothing
      | Bool
otherwise = Bool -> Maybe (Element BitVector)
forall a. a -> Maybe a
Just (Bool -> Maybe (Element BitVector))
-> Bool -> Maybe (Element BitVector)
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
MonoKey BitVector
k


-- |
-- @since 0.1.0
instance MonoTraversable BitVector where

    -- | /O(n)/
    {-# INLINE otraverse #-}
    otraverse :: (Element BitVector -> f (Element BitVector))
-> BitVector -> f BitVector
otraverse f :: Element BitVector -> f (Element BitVector)
f = ([Bool] -> BitVector) -> f [Bool] -> f BitVector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> BitVector
forall (f :: * -> *). Foldable f => f Bool -> BitVector
fromBits (f [Bool] -> f BitVector)
-> (BitVector -> f [Bool]) -> BitVector -> f BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> [Bool] -> f [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Bool -> f Bool
Element BitVector -> f (Element BitVector)
f ([Bool] -> f [Bool])
-> (BitVector -> [Bool]) -> BitVector -> f [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> [Bool]
toBits

    -- | /O(n)/
    {-# INLINE omapM #-}
    omapM :: (Element BitVector -> m (Element BitVector))
-> BitVector -> m BitVector
omapM = (Element BitVector -> m (Element BitVector))
-> BitVector -> m BitVector
forall mono (f :: * -> *).
(MonoTraversable mono, Applicative f) =>
(Element mono -> f (Element mono)) -> mono -> f mono
otraverse


-- |
-- @since 1.0.0
instance MonoTraversableWithKey BitVector where

    -- | /O(n)/
    {-# INLINE otraverseWithKey #-}
    otraverseWithKey :: (MonoKey BitVector -> Element BitVector -> f (Element BitVector))
-> BitVector -> f BitVector
otraverseWithKey f :: MonoKey BitVector -> Element BitVector -> f (Element BitVector)
f = ([Bool] -> BitVector) -> f [Bool] -> f BitVector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> BitVector
forall (f :: * -> *). Foldable f => f Bool -> BitVector
fromBits (f [Bool] -> f BitVector)
-> (BitVector -> f [Bool]) -> BitVector -> f BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Bool -> f Bool) -> [Bool] -> f [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey (Word -> Bool -> f Bool
MonoKey BitVector -> Element BitVector -> f (Element BitVector)
f (Word -> Bool -> f Bool) -> (Int -> Word) -> Int -> Bool -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a. Enum a => Int -> a
toEnum) ([Bool] -> f [Bool])
-> (BitVector -> [Bool]) -> BitVector -> f [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> [Bool]
toBits

    
-- |
-- @since 1.0.0
instance MonoZip BitVector where

    -- | /O(1)/
    {-# INLINE ozipWith #-}
    ozipWith :: (Element BitVector -> Element BitVector -> Element BitVector)
-> BitVector -> BitVector -> BitVector
ozipWith f :: Element BitVector -> Element BitVector -> Element BitVector
f lhs :: BitVector
lhs@(BV w1 :: Word
w1 p :: Natural
p) rhs :: BitVector
rhs@(BV w2 :: Word
w2 q :: Natural
q) =
        let !w0 :: Word
w0   = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
w1 Word
w2
            !mask :: Natural
mask = Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w0) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1
            bv :: Natural -> BitVector
bv    = Word -> Natural -> BitVector
BV Word
w0 (Natural -> BitVector)
-> (Natural -> Natural) -> Natural -> BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural
mask Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&.)
            not' :: BitVector -> Natural
not'  = BitVector -> Natural
nat (BitVector -> Natural)
-> (BitVector -> BitVector) -> BitVector -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> BitVector
forall a. Bits a => a -> a
complement
        -- See the following entry for explanation:
        -- https://en.wikipedia.org/wiki/Truth_table#Truth_table_for_all_binary_logical_operators
        --
        -- cases of f p q
        in  case (Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
True Bool
Element BitVector
False, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
True, Element BitVector -> Element BitVector -> Element BitVector
f Bool
Element BitVector
False Bool
Element BitVector
False) of
              -- Contradiction (Const False)
              (False, False, False, False) -> Natural -> BitVector
bv 0
              -- Logical NOR
              (False, False, False, True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
lhs Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. BitVector -> Natural
not' BitVector
rhs
              -- Converse non-implication
              (False, False, True , False) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
lhs Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
q
              -- NOT p
              (False, False, True , True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
lhs
              -- Logical non-implication
              (False, True , False, False) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. BitVector -> Natural
not' BitVector
rhs
              -- NOT q
              (False, True , False, True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
rhs
              -- Logical XOR
              (False, True , True , False) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
`xor` Natural
q
              -- Logical NAND
              (False, True , True , True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
lhs Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. BitVector -> Natural
not' BitVector
rhs
              -- Logical AND
              (True , False, False, False) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
q
              -- Logical XNOR
              (True , False, False, True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ (Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural
q) Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. (BitVector -> Natural
not' BitVector
lhs Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. BitVector -> Natural
not' BitVector
rhs)
              -- Const q
              (True , False, True , False) -> Natural -> BitVector
bv Natural
q
              -- Logical implication
              (True , False, True , True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ BitVector -> Natural
not' BitVector
lhs Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. Natural
q
              -- Const p
              (True , True , False, False) -> Natural -> BitVector
bv Natural
p
              -- Converse implication
              (True , True , False, True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. BitVector -> Natural
not' BitVector
rhs
              -- Logical OR
              (True , True , True , False) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
p Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.|. Natural
q
              -- Constant True
              (True , True , True , True ) -> Natural -> BitVector
bv (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a. Bits a => Int -> a
bit (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w0) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- 1

  
-- |
-- @since 1.0.0
instance MonoZipWithKey BitVector where

    {-# INLINE ozipWithKey #-}
    ozipWithKey :: (MonoKey BitVector
 -> Element BitVector -> Element BitVector -> Element BitVector)
-> BitVector -> BitVector -> BitVector
ozipWithKey f :: MonoKey BitVector
-> Element BitVector -> Element BitVector -> Element BitVector
f (BV w1 :: Word
w1 n :: Natural
n) (BV w2 :: Word
w2 m :: Natural
m) =
        let w0 :: Word
w0     = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
w1 Word
w2
            go :: Word -> Natural -> Natural
go 0 _ = 0
            go c :: Word
c e :: Natural
e = let !k :: Word
k = Word
w0 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c
                         !i :: Int
i = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
k
                         !j :: Word
j = Word
c Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
                         !b :: Element BitVector
b = MonoKey BitVector
-> Element BitVector -> Element BitVector -> Element BitVector
f Word
MonoKey BitVector
k (Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i) (Natural
m Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i)
                         !a :: Natural
a = Natural
e Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` 1
                         !v :: Natural
v = if Bool
Element BitVector
b then Natural
e else 0
                     in  Natural
v Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word -> Natural -> Natural
go Word
j Natural
a
        in  Word -> Natural -> BitVector
BV Word
w0 (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Word -> Natural -> Natural
go Word
w0 1


-- |
-- @since 0.1.0
instance NFData BitVector where

    -- Already a strict data type,
    -- always in normal form.
    {-# INLINE rnf #-}
    rnf :: BitVector -> ()
rnf = () -> BitVector -> ()
forall a b. a -> b -> a
const ()


-- |
-- @since 0.1.0
instance Ord BitVector where

    {-# INLINE compare #-}
    compare :: BitVector -> BitVector -> Ordering
compare lhs :: BitVector
lhs rhs :: BitVector
rhs =
        case (BitVector -> Word) -> BitVector -> BitVector -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing BitVector -> Word
dim BitVector
lhs BitVector
rhs of
          EQ -> (BitVector -> Natural) -> BitVector -> BitVector -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing BitVector -> Natural
nat BitVector
lhs BitVector
rhs
          v :: Ordering
v  -> Ordering
v


-- |
-- @since 0.1.0
instance Semigroup BitVector where

    {-# INLINE (<>) #-}
    <> :: BitVector -> BitVector -> BitVector
(<>) (BV x :: Word
x m :: Natural
m) (BV y :: Word
y n :: Natural
n) = Word -> Natural -> BitVector
BV (Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
y) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ (Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
x) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
m

    {-# INLINABLE sconcat #-}
    sconcat :: NonEmpty BitVector -> BitVector
sconcat xs :: NonEmpty BitVector
xs = Word -> Natural -> BitVector
BV Word
w' Natural
n'
      where
        (w' :: Word
w', _, n' :: Natural
n') = ((Word, Int, Natural) -> BitVector -> (Word, Int, Natural))
-> (Word, Int, Natural)
-> NonEmpty BitVector
-> (Word, Int, Natural)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Int, Natural) -> BitVector -> (Word, Int, Natural)
f (0, 0, 0) NonEmpty BitVector
xs
        f :: (Word, Int, Natural) -> BitVector -> (Word, Int, Natural)
f (bitCountW :: Word
bitCountW, bitCountI :: Int
bitCountI, natVal :: Natural
natVal) (BV w :: Word
w n :: Natural
n) =
          (Word
bitCountW Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
w, Int
bitCountI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w, Natural
natVal Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ (Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Int
bitCountI))

    {-# INLINE stimes #-}
    stimes :: b -> BitVector -> BitVector
stimes 0  _       = BitVector
forall a. Monoid a => a
mempty
    stimes e :: b
e (BV w :: Word
w n :: Natural
n) = Word -> Natural -> BitVector
BV Word
limit (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Int -> Natural -> Natural
go Int
start Natural
n
      where
        !x :: Int
x     = Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
        !start :: Int
start = Word -> Int
forall a. Enum a => a -> Int
fromEnum (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
limit Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
w
        !limit :: Word
limit = (Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> (b -> Int) -> b -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a. Enum a => a -> Int
fromEnum) b
e Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
w
        go :: Int -> Natural -> Natural
go  0 !Natural
acc = Natural
acc
        go !Int
k !Natural
acc = Int -> Natural -> Natural
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ (Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Int
k) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
acc


-- |
-- @since 0.1.0
instance Show BitVector where

    show :: BitVector -> [Char]
show (BV w :: Word
w n :: Natural
n) = [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat [ "[", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
w, "]", Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
n ]


-- |
-- @since 1.0.0
instance TextShow BitVector where

    showb :: BitVector -> Builder
showb (BV w :: Word
w n :: Natural
n) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ "[", Word -> Builder
forall a. TextShow a => a -> Builder
showb Word
w, "]", Natural -> Builder
forall a. TextShow a => a -> Builder
showb Natural
n ]


-- |
-- Create a bit vector from a /little-endian/ list of bits.
--
-- The following will hold:
--
-- > length . takeWhile not === countLeadingZeros . fromBits
-- > length . takeWhile not . reverse === countTrailingZeros . fromBits
--
-- /Time:/ \(\, \mathcal{O} \left( n \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> fromBits [True, False, False]
-- [3]1
{-# INLINE fromBits #-}
fromBits :: Foldable f => f Bool -> BitVector
fromBits :: f Bool -> BitVector
fromBits bs :: f Bool
bs = Word -> Natural -> BitVector
BV (Int -> Word
forall a. Enum a => Int -> a
toEnum Int
n) Natural
k
  -- NB: 'setBit' is a GMP function, faster than regular addition.
  where
    (!Int
n, !Natural
k) = ((Int, Natural) -> Bool -> (Int, Natural))
-> (Int, Natural) -> f Bool -> (Int, Natural)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Natural) -> Bool -> (Int, Natural)
forall b. Bits b => (Int, b) -> Bool -> (Int, b)
go (0, 0) f Bool
bs
    go :: (Int, b) -> Bool -> (Int, b)
go (!Int
i, !b
v) b :: Bool
b
      | Bool
b         = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, b
v b -> Int -> b
forall a. Bits a => a -> Int -> a
`setBit` Int
i)
      | Bool
otherwise = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, b
v)


-- |
-- Create a /little-endian/ list of bits from a bit vector.
--
-- The following will hold:
--
-- > length . takeWhile not . toBits === countLeadingZeros
-- > length . takeWhile not . reverse . toBits === countTrailingZeros
--
-- /Time:/ \(\, \mathcal{O} \left( n \right) \)
--
-- /Since:/ 0.1.0
--
-- ==== __Examples__
--
-- >>> toBits [4]11
-- [True, True, False, True]
{-# INLINE toBits #-}
toBits :: BitVector -> [Bool]
toBits :: BitVector -> [Bool]
toBits (BV w :: Word
w n :: Natural
n) = Int -> [Bool] -> [Bool]
go (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) []
  where
    go :: Int -> [Bool] -> [Bool]
go 0 bs :: [Bool]
bs = [Bool]
bs
    go i :: Int
i bs :: [Bool]
bs = let !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
              in Int -> [Bool] -> [Bool]
go Int
j ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
j Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
bs


-- |
-- Create a bit vector of non-negative dimension from an integral value.
--
-- The integral value will be treated as an /signed/ number and the resulting
-- bit vector will contain the two's complement bit representation of the number.
--
-- The integral value will be interpreted as /little-endian/ so that the least
-- significant bit of the integral value will be the value of the 0th index of
-- the resulting bit vector and the most significant bit of the integral value
-- will be at index @dimension − 1@.
--
-- Note that if the bit representation of the integral value exceeds the
-- supplied dimension, then the most significant bits will be truncated in the
-- resulting bit vector.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> fromNumber 8 96
-- [8]96
--
-- >>> fromNumber 8 -96
-- [8]160
--
-- >>> fromNumber 6 96
-- [6]32
{-# INLINE[1] fromNumber #-}
fromNumber
  :: Integral v
  => Word  -- ^ dimension of bit vector
  -> v     -- ^ /signed, little-endian/ integral value
  -> BitVector
fromNumber :: Word -> v -> BitVector
fromNumber !Word
dimValue !v
intValue = Word -> Natural -> BitVector
BV Word
dimValue (Natural -> BitVector)
-> (Integer -> Natural) -> Integer -> BitVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
intToNat (Integer -> BitVector) -> Integer -> BitVector
forall a b. (a -> b) -> a -> b
$ Integer
mask Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
v
  where
    !v :: Integer
v | Integer -> Integer
forall a. Num a => a -> a
signum Integer
int Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL 1 Int
intBits Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
int
       | Bool
otherwise      = Integer
int

    !int :: Integer
int     = v -> Integer
forall a. Integral a => a -> Integer
toInteger v
intValue
    !intBits :: Int
intBits = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
int)
    !mask :: Integer
mask    = 2 Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word
dimValue Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1


{-# RULES
"fromNumber/Natural" forall w (n :: Natural).  fromNumber w n = BV w n
"fromNumber/Word"    forall w (v :: Word   ).  fromNumber w v = BV w (wordToNatural v)
  #-}


-- |
-- Two's complement value of a bit vector.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> toSignedNumber [4]0
-- 0
--
-- >>> toSignedNumber [4]3
-- 3
--
-- >>> toSignedNumber [4]7
-- 7
--
-- >>> toSignedNumber [4]8
-- -8
--
-- >>> toSignedNumber [4]12
-- -4
--
-- >>> toSignedNumber [4]15
-- -1
{-# INLINE toSignedNumber #-}
toSignedNumber :: Num a => BitVector -> a
toSignedNumber :: BitVector -> a
toSignedNumber (BV w :: Word
w n :: Natural
n) = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
v
  where
    !i :: Integer
i = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n
    !v :: Integer
v | Natural
n Natural -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL 1 (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i
       | Bool
otherwise = Integer
i


-- |
-- Unsigned value of a bit vector.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> toSignedNumber [4]0
-- 0
--
-- >>> toSignedNumber [4]3
-- 3
--
-- >>> toSignedNumber [4]7
-- 7
--
-- >>> toSignedNumber [4]8
-- 8
--
-- >>> toSignedNumber [4]12
-- 12
--
-- >>> toSignedNumber [4]15
-- 15
{-# INLINE[1] toUnsignedNumber #-}
toUnsignedNumber :: Num a => BitVector -> a
toUnsignedNumber :: BitVector -> a
toUnsignedNumber = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (BitVector -> Integer) -> BitVector -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer)
-> (BitVector -> Natural) -> BitVector -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Natural
nat


{-# RULES
"toUnsignedNumber/Natural" toUnsignedNumber = nat
  #-}


-- |
-- Get the dimension of a 'BitVector'. Preferable to 'finiteBitSize' as it
-- returns a type which cannot represent a non-negative value and a 'BitVector'
-- must have a non-negative dimension.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> dimension [2]3
-- 2
--
-- >>> dimension [4]12
-- 4
{-# INLINE dimension #-}
dimension :: BitVector -> Word
dimension :: BitVector -> Word
dimension = BitVector -> Word
dim


-- |
-- Determine if /any/ bits are set in the 'BitVector'.
-- Faster than @(0 ==) . popCount@.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> isZeroVector [2]3
-- False
--
-- >>> isZeroVector [4]0
-- True
{-# INLINE isZeroVector #-}
isZeroVector :: BitVector -> Bool
isZeroVector :: BitVector -> Bool
isZeroVector = (0 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
==) (Natural -> Bool) -> (BitVector -> Natural) -> BitVector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector -> Natural
nat


-- |
-- Get the /inclusive/ range of bits in 'BitVector' as a new 'BitVector'.
--
-- If either of the bounds of the subrange exceed the bit vector's dimension,
-- the resulting subrange will append an infinite number of zeroes to the end
-- of the bit vector in order to satisfy the subrange request.
--
-- /Time:/ \(\, \mathcal{O} \left( 1 \right) \)
--
-- /Since: 0.1.0/
--
-- ==== __Examples__
--
-- >>> subRange (0,2) [4]7
-- [3]7
--
-- >>> subRange (1, 3) [4]7
-- [3]3
--
-- >>> subRange (2, 4) [4]7
-- [3]1
--
-- >>> subRange (3, 5) [4]7
-- [3]0
--
-- >>> subRange (10, 20) [4]7
-- [10]0
{-# INLINE subRange #-}
subRange :: (Word, Word) -> BitVector -> BitVector
subRange :: (Word, Word) -> BitVector -> BitVector
subRange (!Word
lower, !Word
upper) (BV _ n :: Natural
n)
  | Word
lower Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
upper = BitVector
forall a. Bits a => a
zeroBits
  | Bool
otherwise     =
    case Word -> Maybe Int
toInt Word
lower of
      Nothing -> BitVector
forall a. Bits a => a
zeroBits
      Just i :: Int
i  ->
        let b :: Natural
b = Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftR` Int
i
        in  case Word -> Maybe Int
toInt Word
upper of
              Nothing ->
                let m :: Word
m = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
                in  Word -> Natural -> BitVector
BV Word
m (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$  Natural
n Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftR` Int
i
              Just j :: Int
j  ->
                let x :: Int
x = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
                    m :: Int
m | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound = Int
x
                      | Bool
otherwise     = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
                in  Word -> Natural -> BitVector
BV (Int -> Word
forall a. Enum a => Int -> a
toEnum Int
m) (Natural -> BitVector) -> Natural -> BitVector
forall a b. (a -> b) -> a -> b
$ Natural
b Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
.&. Natural -> Natural
forall a. Enum a => a -> a
pred (1 Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL` Int
m)



-- |
-- Determine the number of /set/ bits in the 'BitVector' up to, /but not including/, index @k@.
--
-- To determine the number of /unset/ bits in the 'BitVector`, use @k - rank bv k@.
--
-- Uses "broadword programming." Efficient on small 'BitVector's (10^3).
--
-- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'.
--
-- /Since: 1.1.0/
--
-- ==== __Examples__
--
-- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65
--
-- >>> rank bv   0  -- Count how many ones in the first 0 bits (always returns 0)
-- 0
--
-- >>> rank bv   1  -- Count how many ones in the first 1 bits
-- 1
--
-- >>> rank bv   2  -- Count how many ones in the first 2 bits
-- 1
--
-- >>> rank bv  65  -- Count how many ones in the first 65 bits
-- 1
--
-- >>> rank bv  66  -- Count how many ones in the first 66 bits
-- 1
--
-- >>> rank bv 128  -- Count how many ones in all 128 bits
-- 2
--
-- >>> rank bv 129  -- Out-of-bounds, fails gracefully
-- 2
rank
  :: BitVector
  -> Word -- ^ \(k\), the rank index 
  -> Word -- ^ Set bits within the rank index
rank :: BitVector -> Word -> Word
rank             _ 0 = 0 -- There can be no set bits /before/ the 0-th bit
rank (BV 0      _) _ = 0 -- There can be no set bits in a bit-vector of length 0
rank (BV w :: Word
w natVal :: Natural
natVal) k :: Word
k =
    let j :: Word
j = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
k Word
w
    in  case Natural
natVal of
          NatS#      v :: GmpLimb#
v  -> Word -> Word -> Word
wordRank (GmpLimb# -> Word
W# GmpLimb#
v) Word
j
          NatJ# (BN# v :: ByteArray#
v) -> ByteArray -> Word -> Word
f (ByteArray# -> ByteArray
ByteArray ByteArray#
v) Word
j
  where
    f :: ByteArray -> Word -> Word
    f :: ByteArray -> Word -> Word
f byteArr :: ByteArray
byteArr x :: Word
x = Word -> Int -> Word
g Word
x 0
      where
        g :: Word -> Int -> Word
        g :: Word -> Int -> Word
g !Word
j !Int
i
          | Word
j Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
bitsInWord = Word -> Word -> Word
wordRank Word
value Word
j
          | Bool
otherwise = let !v :: Word
v = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Bits a => a -> Int
popCount Word
value
                        in   Word
v Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word -> Int -> Word
g (Word
j Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
bitsInWord) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
          where
            value :: Word
            value :: Word
value = ByteArray
byteArr ByteArray -> Int -> Word
forall a. Prim a => ByteArray -> Int -> a
`indexByteArray` Int
i


-- |
-- Find the index of the k-th set bit in the 'BitVector'.
--
-- To find the index of the k-th /unset/ bit in the 'BitVector`, use @select (complement bv) k@.
--
-- Uses "broadword programming." Efficient on small 'BitVector's (10^3).
--
-- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'.
--
-- /Since: 1.1.0/
--
-- ==== __Examples__
--
-- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65
--
-- >>> select bv 0  -- Find the 0-indexed position of the first one bit
-- Just 0
--
-- >>> select bv 1  -- Find the 0-indexed position of the second one bit
-- Just 65
--
-- >>> select bv 2  -- There is no 3rd set bit, `select` fails
-- Nothing
select
  :: BitVector
  -> Word        -- ^ \(k\), the select index 
  -> Maybe Word  -- ^ index of the k-th set bit
select :: BitVector -> Word -> Maybe Word
select (BV 0      _) _ = Maybe Word
forall a. Maybe a
Nothing -- There can be no set bits in a bit-vector of length 0
select (BV w :: Word
w natVal :: Natural
natVal) k :: Word
k =
    case Natural
natVal of
      NatS#      v :: GmpLimb#
v  -> let !u :: Word
u = GmpLimb# -> Word
W# GmpLimb#
v
                       in  if Int -> Word
forall a. Enum a => Int -> a
toEnum (Word -> Int
forall a. Bits a => a -> Int
popCount Word
u) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
k
                           then Maybe Word
forall a. Maybe a
Nothing
                           else Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word
wordSelect Word
u Word
k
      NatJ# (BN# v :: ByteArray#
v) -> ByteArray -> Word -> Maybe Word
f (ByteArray# -> ByteArray
ByteArray ByteArray#
v) Word
k
  where
    f :: ByteArray -> Word -> Maybe Word
    f :: ByteArray -> Word -> Maybe Word
f byteArr :: ByteArray
byteArr x :: Word
x = Word -> Int -> Maybe Word
g Word
x 0
      where
        g :: Word -> Int -> Maybe Word
        g :: Word -> Int -> Maybe Word
g !Word
j !Int
i
          | Int -> Word
forall a. Enum a => Int -> a
toEnum Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
bitsInWord Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
w = Maybe Word
forall a. Maybe a
Nothing
          | Word
j Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
ones  = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word
wordSelect Word
value Word
j
          | Bool
otherwise = (Word
bitsInWord Word -> Word -> Word
forall a. Num a => a -> a -> a
+) (Word -> Word) -> Maybe Word -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Int -> Maybe Word
g (Word
j Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ones) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
          where
            ones :: Word
ones = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Bits a => a -> Int
popCount Word
value
            value :: Word
            value :: Word
value = ByteArray
byteArr ByteArray -> Int -> Word
forall a. Prim a => ByteArray -> Int -> a
`indexByteArray` Int
i


-- |
-- Number of bits in a 'Word'.
--
-- Used for "broadword programming."
{-# INLINE bitsInWord #-}
bitsInWord :: Word
bitsInWord :: Word
bitsInWord = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined :: Word)


-- |
-- Clever use of 'popCount' and masking to get the number of set bits up to,
-- /but not including/,  index "k."
wordRank
  :: Word -- ^ Input 'Word'
  -> Word -- ^ Index k, upt to which we count all set bits, k in range [ 0, finiteBitCount - 1 ]
  -> Word -- ^ THe number of bits set within index "k."
wordRank :: Word -> Word -> Word
wordRank v :: Word
v x :: Word
x = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> (Word -> Int) -> Word -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a. Bits a => a -> Int
popCount (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Word
suffixOnes Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
v
  where
    suffixOnes :: Word
suffixOnes = (1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
x) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1


-- |
-- Perform binary search with 'popCount' to locate the k-th set bit
wordSelect
  :: Word -- ^ Input 'Word'
  -> Word -- ^ Find the k-th set bit, k in range [ 0, finiteBitCount - 1 ]
  -> Word -- ^ The index of the k-th set bit
wordSelect :: Word -> Word -> Word
wordSelect v :: Word
v = Word -> Word -> Word -> Word
go 0 63
  where
    go :: Word -> Word -> Word -> Word
    go :: Word -> Word -> Word -> Word
go  lb :: Word
lb ub :: Word
ub x :: Word
x
      | Word
lb Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
ub = if Word
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Word
v Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
lb then Word
lb else Word
ub
      | Bool
otherwise =
          let !lowOnes :: Word
lowOnes =  Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> (Word -> Int) -> Word -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a. Bits a => a -> Int
popCount (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Word
lowMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
v
          in  if Word
lowOnes Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
x
              then Word -> Word -> Word -> Word
go Word
lb Word
mb Word
x
              else Word -> Word -> Word -> Word
go (Word
mb Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1) Word
ub (Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
lowOnes)
      where
        mb :: Word
mb = ((Word
ub Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
lb) Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` 2) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
lb
        lowMask :: Word
lowMask = Word -> Word -> Word
forall a. Enum a => a -> Word -> Word
makeMask Word
lb Word
mb

        makeMask :: a -> Word -> Word
makeMask i :: a
i j :: Word
j = Word
wideMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
thinMask
          where
            thinMask :: Word
thinMask = (1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` a -> Int
forall a. Enum a => a -> Int
fromEnum a
i) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
            wideMask :: Word
wideMask
              | Word
j Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bitsInWord Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 = Word
forall a. Bounded a => a
maxBound :: Word
              | Bool
otherwise = (1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1


toInt :: Word -> Maybe Int
toInt :: Word -> Maybe Int
toInt w :: Word
w
  | Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
maxInt = Maybe Int
forall a. Maybe a
Nothing
  | Bool
otherwise  = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
w
  where
    maxInt :: Word
maxInt = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int
forall a. Bounded a => a
maxBound :: Int)


-- |
-- While similar to the function 'naturalFromInteger' exported from GHC.Natural,
-- this function does not throw an exception when an negative valued 'Integer'
-- is supplied and is also compatible with base < 4.10.0.0.
{-# INLINE intToNat #-}
-- {-# NOINLINE intToNat #-}
intToNat :: Integer -> Natural
intToNat :: Integer -> Natural
intToNat (S#  i# :: Int#
i#) | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# 0#)               = GmpLimb# -> Natural
NatS# (Int# -> GmpLimb#
int2Word# Int#
i#)
intToNat (Jp# bn :: BigNat
bn) | Int# -> Bool
isTrue# (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# 1#) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
bn)
                  | Bool
otherwise                         = BigNat -> Natural
NatJ# BigNat
bn
intToNat _                                            = GmpLimb# -> Natural
NatS# (Int# -> GmpLimb#
int2Word# 0#)