{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
module PlutusCore.Bitwise (
integerToByteString,
byteStringToInteger,
andByteString,
orByteString,
xorByteString,
complementByteString,
shiftByteString,
rotateByteString,
readBit,
writeBits,
replicateByte,
countSetBits,
findFirstSetBit,
IntegerToByteStringError (..),
maximumOutputLength
) where
import PlutusCore.Builtin (BuiltinResult, emit)
import PlutusCore.Evaluation.Result (evaluationFailure)
import ByteString.StrictBuilder (Builder)
import ByteString.StrictBuilder qualified as Builder
import Control.Exception (Exception, throwIO, try)
import Control.Monad (guard, unless, when)
import Data.Bits (unsafeShiftL, unsafeShiftR, (.|.))
import Data.Bits qualified as Bits
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Internal qualified as BSI
import Data.Foldable (for_)
import Data.Text (pack)
import Data.Word (Word64, Word8)
import Foreign.Marshal.Utils (copyBytes, fillBytes)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (peekByteOff, peekElemOff, pokeByteOff, pokeElemOff)
import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian))
import GHC.Exts (Int (I#))
import GHC.Integer.Logarithms (integerLog2#)
import GHC.IO.Unsafe (unsafeDupablePerformIO)
maximumOutputLength :: Integer
maximumOutputLength :: Integer
maximumOutputLength = Integer
8192
integerLog2 :: Integer -> Int
integerLog2 :: Integer -> Int
integerLog2 !Integer
i = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
i)
integerToByteString :: Bool -> Integer -> Integer -> BuiltinResult ByteString
integerToByteString :: Bool -> Integer -> Integer -> BuiltinResult ByteString
integerToByteString Bool
endiannessArg Integer
lengthArg Integer
input
| Integer
lengthArg Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = do
Text -> BuiltinResult ()
emit Text
"integerToByteString: negative length argument"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Length requested: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
input)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
| Integer
lengthArg Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maximumOutputLength = do
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ())
-> ([Char] -> Text) -> [Char] -> BuiltinResult ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> BuiltinResult ()) -> [Char] -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ [Char]
"integerToByteString: requested length is too long (maximum is "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
maximumOutputLength
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes)"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Length requested: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
lengthArg)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
| Integer
lengthArg Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
Bool -> Bool -> Bool
&& Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
integerLog2 Integer
input) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maximumOutputLength =
let bytesRequiredFor :: Integer -> Int
bytesRequiredFor Integer
n = Integer -> Int
integerLog2 Integer
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in do
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ())
-> ([Char] -> Text) -> [Char] -> BuiltinResult ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> BuiltinResult ()) -> [Char] -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ [Char]
"integerToByteString: input too long (maximum is 2^"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maximumOutputLength)
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-1)"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Length required: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> Int
bytesRequiredFor Integer
input)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
| Bool
otherwise = let endianness :: ByteOrder
endianness = Bool -> ByteOrder
endiannessArgToByteOrder Bool
endiannessArg in
case ByteOrder
-> Int -> Integer -> Either IntegerToByteStringError ByteString
unsafeIntegerToByteString ByteOrder
endianness (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
lengthArg) Integer
input of
Left IntegerToByteStringError
err -> case IntegerToByteStringError
err of
IntegerToByteStringError
NegativeInput -> do
Text -> BuiltinResult ()
emit Text
"integerToByteString: cannot convert negative Integer"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Input: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
input)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
IntegerToByteStringError
NotEnoughDigits -> do
Text -> BuiltinResult ()
emit Text
"integerToByteString: cannot represent Integer in given number of bytes"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Input: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
input)
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Bytes requested: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
lengthArg)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
Right ByteString
result -> ByteString -> BuiltinResult ByteString
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
result
data IntegerToByteStringError =
NegativeInput |
NotEnoughDigits
deriving stock (IntegerToByteStringError -> IntegerToByteStringError -> Bool
(IntegerToByteStringError -> IntegerToByteStringError -> Bool)
-> (IntegerToByteStringError -> IntegerToByteStringError -> Bool)
-> Eq IntegerToByteStringError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntegerToByteStringError -> IntegerToByteStringError -> Bool
== :: IntegerToByteStringError -> IntegerToByteStringError -> Bool
$c/= :: IntegerToByteStringError -> IntegerToByteStringError -> Bool
/= :: IntegerToByteStringError -> IntegerToByteStringError -> Bool
Eq, Int -> IntegerToByteStringError -> [Char] -> [Char]
[IntegerToByteStringError] -> [Char] -> [Char]
IntegerToByteStringError -> [Char]
(Int -> IntegerToByteStringError -> [Char] -> [Char])
-> (IntegerToByteStringError -> [Char])
-> ([IntegerToByteStringError] -> [Char] -> [Char])
-> Show IntegerToByteStringError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> IntegerToByteStringError -> [Char] -> [Char]
showsPrec :: Int -> IntegerToByteStringError -> [Char] -> [Char]
$cshow :: IntegerToByteStringError -> [Char]
show :: IntegerToByteStringError -> [Char]
$cshowList :: [IntegerToByteStringError] -> [Char] -> [Char]
showList :: [IntegerToByteStringError] -> [Char] -> [Char]
Show)
endiannessArgToByteOrder :: Bool -> ByteOrder
endiannessArgToByteOrder :: Bool -> ByteOrder
endiannessArgToByteOrder Bool
b = if Bool
b then ByteOrder
BigEndian else ByteOrder
LittleEndian
unsafeIntegerToByteString :: ByteOrder -> Int -> Integer -> Either IntegerToByteStringError ByteString
unsafeIntegerToByteString :: ByteOrder
-> Int -> Integer -> Either IntegerToByteStringError ByteString
unsafeIntegerToByteString ByteOrder
requestedByteOrder Int
requestedLength Integer
input
| Integer
input Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = IntegerToByteStringError
-> Either IntegerToByteStringError ByteString
forall a b. a -> Either a b
Left IntegerToByteStringError
NegativeInput
| Integer
input Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = ByteString -> Either IntegerToByteStringError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either IntegerToByteStringError ByteString)
-> (Word8 -> ByteString)
-> Word8
-> Either IntegerToByteStringError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
BS.replicate Int
requestedLength (Word8 -> Either IntegerToByteStringError ByteString)
-> Word8 -> Either IntegerToByteStringError ByteString
forall a b. (a -> b) -> a -> b
$ Word8
0x00
| Int
requestedLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> Either IntegerToByteStringError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either IntegerToByteStringError ByteString)
-> (Builder -> ByteString)
-> Builder
-> Either IntegerToByteStringError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.builderBytes (Builder -> Either IntegerToByteStringError ByteString)
-> Builder -> Either IntegerToByteStringError ByteString
forall a b. (a -> b) -> a -> b
$ case ByteOrder
requestedByteOrder of
ByteOrder
LittleEndian -> Builder -> Integer -> Builder
goLENoLimit Builder
forall a. Monoid a => a
mempty Integer
input
ByteOrder
BigEndian -> Builder -> Integer -> Builder
goBENoLimit Builder
forall a. Monoid a => a
mempty Integer
input
| Bool
otherwise = do
let result :: Maybe Builder
result = case ByteOrder
requestedByteOrder of
ByteOrder
LittleEndian -> Builder -> Integer -> Maybe Builder
goLELimit Builder
forall a. Monoid a => a
mempty Integer
input
ByteOrder
BigEndian -> Builder -> Integer -> Maybe Builder
goBELimit Builder
forall a. Monoid a => a
mempty Integer
input
case Maybe Builder
result of
Maybe Builder
Nothing -> IntegerToByteStringError
-> Either IntegerToByteStringError ByteString
forall a b. a -> Either a b
Left IntegerToByteStringError
NotEnoughDigits
Just Builder
b -> ByteString -> Either IntegerToByteStringError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either IntegerToByteStringError ByteString)
-> (Builder -> ByteString)
-> Builder
-> Either IntegerToByteStringError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.builderBytes (Builder -> Either IntegerToByteStringError ByteString)
-> Builder -> Either IntegerToByteStringError ByteString
forall a b. (a -> b) -> a -> b
$ Builder
b
where
goLELimit :: Builder -> Integer -> Maybe Builder
goLELimit :: Builder -> Integer -> Maybe Builder
goLELimit Builder
acc Integer
remaining
| Integer
remaining Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder -> Maybe Builder
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
padLE Builder
acc
| Bool
otherwise = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Builder -> Int
Builder.builderLength Builder
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
requestedLength)
let newRemaining :: Integer
newRemaining = Integer
remaining Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
64
let Word64
digitGroup :: Word64 = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
remaining
case Integer
newRemaining of
Integer
0 -> Builder -> Word64 -> Maybe Builder
finishLELimit Builder
acc Word64
digitGroup
Integer
_ -> Builder -> Integer -> Maybe Builder
goLELimit (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
forall a. Storable a => a -> Builder
Builder.storable Word64
digitGroup) Integer
newRemaining
finishLELimit :: Builder -> Word64 -> Maybe Builder
finishLELimit :: Builder -> Word64 -> Maybe Builder
finishLELimit Builder
acc Word64
remaining
| Word64
remaining Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Builder -> Maybe Builder
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
padLE Builder
acc
| Bool
otherwise = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Builder -> Int
Builder.builderLength Builder
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
requestedLength)
let newRemaining :: Word64
newRemaining = Word64
remaining Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
let Word8
digit :: Word8 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
remaining
Builder -> Word64 -> Maybe Builder
finishLELimit (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
digit) Word64
newRemaining
goLENoLimit :: Builder -> Integer -> Builder
goLENoLimit :: Builder -> Integer -> Builder
goLENoLimit Builder
acc Integer
remaining
| Integer
remaining Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder
acc
| Bool
otherwise = let newRemaining :: Integer
newRemaining = Integer
remaining Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
64
Word64
digitGroup :: Word64 = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
remaining
in case Integer
newRemaining of
Integer
0 -> Builder -> Word64 -> Builder
finishLENoLimit Builder
acc Word64
digitGroup
Integer
_ -> Builder -> Integer -> Builder
goLENoLimit (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
forall a. Storable a => a -> Builder
Builder.storable Word64
digitGroup) Integer
newRemaining
finishLENoLimit :: Builder -> Word64 -> Builder
finishLENoLimit :: Builder -> Word64 -> Builder
finishLENoLimit Builder
acc Word64
remaining
| Word64
remaining Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Builder
acc
| Bool
otherwise =
let newRemaining :: Word64
newRemaining = Word64
remaining Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
Word8
digit :: Word8 = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
remaining
in Builder -> Word64 -> Builder
finishLENoLimit (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
digit) Word64
newRemaining
padLE :: Builder -> Builder
padLE :: Builder -> Builder
padLE Builder
acc = let paddingLength :: Int
paddingLength = Int
requestedLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Builder -> Int
Builder.builderLength Builder
acc
in Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.bytes (Int -> Word8 -> ByteString
BS.replicate Int
paddingLength Word8
0x0)
goBELimit :: Builder -> Integer -> Maybe Builder
goBELimit :: Builder -> Integer -> Maybe Builder
goBELimit Builder
acc Integer
remaining
| Integer
remaining Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder -> Maybe Builder
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
padBE Builder
acc
| Bool
otherwise = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Builder -> Int
Builder.builderLength Builder
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
requestedLength)
let newRemaining :: Integer
newRemaining = Integer
remaining Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
64
let Word64
digitGroup :: Word64 = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
remaining
case Integer
newRemaining of
Integer
0 -> Builder -> Word64 -> Maybe Builder
finishBELimit Builder
acc Word64
digitGroup
Integer
_ -> Builder -> Integer -> Maybe Builder
goBELimit (Word64 -> Builder
Builder.word64BE Word64
digitGroup Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc) Integer
newRemaining
finishBELimit :: Builder -> Word64 -> Maybe Builder
finishBELimit :: Builder -> Word64 -> Maybe Builder
finishBELimit Builder
acc Word64
remaining
| Word64
remaining Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Builder -> Maybe Builder
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
padBE Builder
acc
| Bool
otherwise = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Builder -> Int
Builder.builderLength Builder
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
requestedLength)
let newRemaining :: Word64
newRemaining = Word64
remaining Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
let digit :: Word8
digit = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
remaining
Builder -> Word64 -> Maybe Builder
finishBELimit (Word8 -> Builder
Builder.word8 Word8
digit Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc) Word64
newRemaining
goBENoLimit :: Builder -> Integer -> Builder
goBENoLimit :: Builder -> Integer -> Builder
goBENoLimit Builder
acc Integer
remaining
| Integer
remaining Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder
acc
| Bool
otherwise = let newRemaining :: Integer
newRemaining = Integer
remaining Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
64
digitGroup :: Word64
digitGroup = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
remaining
in case Integer
newRemaining of
Integer
0 -> Builder -> Word64 -> Builder
finishBENoLimit Builder
acc Word64
digitGroup
Integer
_ -> Builder -> Integer -> Builder
goBENoLimit (Word64 -> Builder
Builder.word64BE Word64
digitGroup Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc) Integer
newRemaining
finishBENoLimit :: Builder -> Word64 -> Builder
finishBENoLimit :: Builder -> Word64 -> Builder
finishBENoLimit Builder
acc Word64
remaining
| Word64
remaining Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Builder
acc
| Bool
otherwise = let newRemaining :: Word64
newRemaining = Word64
remaining Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
digit :: Word8
digit = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
remaining
in Builder -> Word64 -> Builder
finishBENoLimit (Word8 -> Builder
Builder.word8 Word8
digit Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc) Word64
newRemaining
padBE :: Builder -> Builder
padBE :: Builder -> Builder
padBE Builder
acc = let paddingLength :: Int
paddingLength = Int
requestedLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Builder -> Int
Builder.builderLength Builder
acc in
ByteString -> Builder
Builder.bytes (Int -> Word8 -> ByteString
BS.replicate Int
paddingLength Word8
0x0) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc
byteStringToInteger ::
Bool -> ByteString -> Integer
byteStringToInteger :: Bool -> ByteString -> Integer
byteStringToInteger Bool
statedEndiannessArg ByteString
input =
let endianness :: ByteOrder
endianness = Bool -> ByteOrder
endiannessArgToByteOrder Bool
statedEndiannessArg in
ByteOrder -> ByteString -> Integer
unsafeByteStringToInteger ByteOrder
endianness ByteString
input
unsafeByteStringToInteger :: ByteOrder -> ByteString -> Integer
unsafeByteStringToInteger :: ByteOrder -> ByteString -> Integer
unsafeByteStringToInteger ByteOrder
statedByteOrder ByteString
input = case ByteOrder
statedByteOrder of
ByteOrder
LittleEndian -> case (Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndexEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x00) ByteString
input of
Maybe Int
Nothing -> Integer
0
Just Int
end -> Integer -> Int -> Int -> Integer
goLE Integer
0 Int
end Int
0
ByteOrder
BigEndian -> case (Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndex (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x00) ByteString
input of
Maybe Int
Nothing -> Integer
0
Just Int
end -> Integer -> Int -> Int -> Int -> Integer
goBE Integer
0 Int
end Int
0 (ByteString -> Int
BS.length ByteString
input Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
goLE :: Integer -> Int -> Int -> Integer
goLE :: Integer -> Int -> Int -> Integer
goLE Integer
acc Int
limit Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) =
let digitGroup :: Word64
digitGroup = Int -> Word64
read64LE Int
ix
shift :: Int
shift = Int
ix Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3
newIx :: Int
newIx = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
newAcc :: Integer
newAcc = Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
digitGroup Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift
in Integer -> Int -> Int -> Integer
goLE Integer
newAcc Int
limit Int
newIx
| Bool
otherwise = Integer -> Int -> Int -> Integer
finishLE Integer
acc Int
limit Int
ix
finishLE :: Integer -> Int -> Int -> Integer
finishLE :: Integer -> Int -> Int -> Integer
finishLE Integer
acc Int
limit Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit = Integer
acc
| Bool
otherwise =
let digit :: Word8
digit = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input Int
ix
shift :: Int
shift = Int
ix Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3
newIx :: Int
newIx = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
newAcc :: Integer
newAcc = Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
digit Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift
in Integer -> Int -> Int -> Integer
finishLE Integer
newAcc Int
limit Int
newIx
read64LE :: Int -> Word64
read64LE :: Int -> Word64
read64LE Int
startIx =
Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input Int
startIx)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
40)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
startIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
56)
goBE :: Integer -> Int -> Int -> Int -> Integer
goBE :: Integer -> Int -> Int -> Int -> Integer
goBE Integer
acc Int
limit Int
shift Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) =
let digitGroup :: Word64
digitGroup = Int -> Word64
read64BE Int
ix
newShift :: Int
newShift = Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64
newIx :: Int
newIx = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8
newAcc :: Integer
newAcc = Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
digitGroup Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift
in Integer -> Int -> Int -> Int -> Integer
goBE Integer
newAcc Int
limit Int
newShift Int
newIx
| Bool
otherwise = Integer -> Int -> Int -> Int -> Integer
finishBE Integer
acc Int
limit Int
shift Int
ix
finishBE :: Integer -> Int -> Int -> Int -> Integer
finishBE :: Integer -> Int -> Int -> Int -> Integer
finishBE Integer
acc Int
limit Int
shift Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit = Integer
acc
| Bool
otherwise =
let digit :: Word8
digit = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input Int
ix
newShift :: Int
newShift = Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
newIx :: Int
newIx = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
newAcc :: Integer
newAcc = Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
digit Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shift
in Integer -> Int -> Int -> Int -> Integer
finishBE Integer
newAcc Int
limit Int
newShift Int
newIx
read64BE :: Int -> Word64
read64BE :: Int -> Word64
read64BE Int
endIx =
Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input Int
endIx)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
40)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
input (Int
endIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
56)
{-# INLINEABLE andByteString #-}
andByteString :: Bool -> ByteString -> ByteString -> ByteString
andByteString :: Bool -> ByteString -> ByteString -> ByteString
andByteString Bool
shouldPad ByteString
bs1 ByteString
bs2 =
let (ByteString
shorter, ByteString
longer) = if ByteString -> Int
BS.length ByteString
bs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs2 then (ByteString
bs1, ByteString
bs2) else (ByteString
bs2, ByteString
bs1)
(ByteString
toCopy, ByteString
toTraverse) = if Bool
shouldPad then (ByteString
longer, ByteString
shorter) else (ByteString
shorter, ByteString
longer)
in ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse (ByteString -> Int
BS.length ByteString
shorter)
where
go :: ByteString -> ByteString -> Int -> ByteString
go :: ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse Int
traverseLen =
IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
toCopy ((CStringLen -> IO ByteString) -> ByteString)
-> (CStringLen -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
copyPtr, Int
copyLen) ->
ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
toTraverse ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
traversePtr -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
copyLen ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
copyPtr) Int
copyLen
let (Int
bigStrides, Int
littleStrides) = Int
traverseLen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
let offset :: Int
offset = Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
let Ptr Word64
bigDstPtr :: Ptr Word64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr
let Ptr Word64
bigTraversePtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
traversePtr
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word64
w64_1 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigDstPtr Int
i
Word64
w64_2 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigTraversePtr Int
i
Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
bigDstPtr Int
i (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64
w64_1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..&. Word64
w64_2
let Ptr Word8
smallDstPtr :: Ptr Word8 = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
offset
let Ptr Word8
smallTraversePtr :: Ptr Word8 = Ptr CChar -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
traversePtr Int
offset
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
littleStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word8
w8_1 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallDstPtr Int
i
Word8
w8_2 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallTraversePtr Int
i
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
smallDstPtr Int
i (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8
w8_1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..&. Word8
w8_2
{-# INLINEABLE orByteString #-}
orByteString :: Bool -> ByteString -> ByteString -> ByteString
orByteString :: Bool -> ByteString -> ByteString -> ByteString
orByteString Bool
shouldPad ByteString
bs1 ByteString
bs2 =
let (ByteString
shorter, ByteString
longer) = if ByteString -> Int
BS.length ByteString
bs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs2 then (ByteString
bs1, ByteString
bs2) else (ByteString
bs2, ByteString
bs1)
(ByteString
toCopy, ByteString
toTraverse) = if Bool
shouldPad then (ByteString
longer, ByteString
shorter) else (ByteString
shorter, ByteString
longer)
in ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse (ByteString -> Int
BS.length ByteString
shorter)
where
go :: ByteString -> ByteString -> Int -> ByteString
go :: ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse Int
traverseLen =
IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
toCopy ((CStringLen -> IO ByteString) -> ByteString)
-> (CStringLen -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
copyPtr, Int
copyLen) ->
ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
toTraverse ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
traversePtr -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
copyLen ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
copyPtr) Int
copyLen
let (Int
bigStrides, Int
littleStrides) = Int
traverseLen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
let offset :: Int
offset = Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
let Ptr Word64
bigDstPtr :: Ptr Word64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr
let Ptr Word64
bigTraversePtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
traversePtr
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word64
w64_1 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigDstPtr Int
i
Word64
w64_2 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigTraversePtr Int
i
Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
bigDstPtr Int
i (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64
w64_1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..|. Word64
w64_2
let Ptr Word8
smallDstPtr :: Ptr Word8 = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
offset
let Ptr Word8
smallTraversePtr :: Ptr Word8 = Ptr CChar -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
traversePtr Int
offset
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
littleStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word8
w8_1 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallDstPtr Int
i
Word8
w8_2 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallTraversePtr Int
i
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
smallDstPtr Int
i (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8
w8_1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..|. Word8
w8_2
{-# INLINEABLE xorByteString #-}
xorByteString :: Bool -> ByteString -> ByteString -> ByteString
xorByteString :: Bool -> ByteString -> ByteString -> ByteString
xorByteString Bool
shouldPad ByteString
bs1 ByteString
bs2 =
let (ByteString
shorter, ByteString
longer) = if ByteString -> Int
BS.length ByteString
bs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs2 then (ByteString
bs1, ByteString
bs2) else (ByteString
bs2, ByteString
bs1)
(ByteString
toCopy, ByteString
toTraverse) = if Bool
shouldPad then (ByteString
longer, ByteString
shorter) else (ByteString
shorter, ByteString
longer)
in ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse (ByteString -> Int
BS.length ByteString
shorter)
where
go :: ByteString -> ByteString -> Int -> ByteString
go :: ByteString -> ByteString -> Int -> ByteString
go ByteString
toCopy ByteString
toTraverse Int
traverseLen =
IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
toCopy ((CStringLen -> IO ByteString) -> ByteString)
-> (CStringLen -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
copyPtr, Int
copyLen) ->
ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
toTraverse ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
traversePtr -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
copyLen ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
copyPtr) Int
copyLen
let (Int
bigStrides, Int
littleStrides) = Int
traverseLen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
let offset :: Int
offset = Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
let Ptr Word64
bigDstPtr :: Ptr Word64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr
let Ptr Word64
bigTraversePtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
traversePtr
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word64
w64_1 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigDstPtr Int
i
Word64
w64_2 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigTraversePtr Int
i
Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
bigDstPtr Int
i (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits.xor Word64
w64_1 Word64
w64_2
let Ptr Word8
smallDstPtr :: Ptr Word8 = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
offset
let Ptr Word8
smallTraversePtr :: Ptr Word8 = Ptr CChar -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
traversePtr Int
offset
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
littleStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word8
w8_1 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallDstPtr Int
i
Word8
w8_2 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallTraversePtr Int
i
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
smallDstPtr Int
i (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits.xor Word8
w8_1 Word8
w8_2
{-# INLINEABLE complementByteString #-}
complementByteString :: ByteString -> ByteString
complementByteString :: ByteString -> ByteString
complementByteString ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> ByteString)
-> (CStringLen -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
srcPtr, Int
len) -> do
let (Int
bigStrides, Int
littleStrides) = Int
len Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
let offset :: Int
offset = Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
let Ptr Word64
bigSrcPtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr
let Ptr Word64
bigDstPtr :: Ptr Word64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word64
w64 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigSrcPtr Int
i
Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
bigDstPtr Int
i (Word64 -> IO ()) -> (Word64 -> Word64) -> Word64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a. Bits a => a -> a
Bits.complement (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64
w64
let Ptr Word8
smallSrcPtr :: Ptr Word8 = Ptr CChar -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
srcPtr Int
offset
let Ptr Word8
smallDstPtr :: Ptr Word8 = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
offset
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
littleStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Word8
w8 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallSrcPtr Int
i
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
smallDstPtr Int
i (Word8 -> IO ()) -> (Word8 -> Word8) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
forall a. Bits a => a -> a
Bits.complement (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8
w8
{-# INLINEABLE readBit #-}
readBit :: ByteString -> Int -> BuiltinResult Bool
readBit :: ByteString -> Int -> BuiltinResult Bool
readBit ByteString
bs Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = do
Text -> BuiltinResult ()
emit Text
"readBit: index out of bounds"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Index: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
ix)
BuiltinResult Bool
forall err. AsEvaluationFailure err => err
evaluationFailure
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 = do
Text -> BuiltinResult ()
emit Text
"readBit: index out of bounds"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Index: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
ix)
BuiltinResult Bool
forall err. AsEvaluationFailure err => err
evaluationFailure
| Bool
otherwise = do
let (Int
bigIx, Int
littleIx) = Int
ix Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
let flipIx :: Int
flipIx = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bigIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Bool -> BuiltinResult Bool
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> BuiltinResult Bool) -> Bool -> BuiltinResult Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
flipIx) Int
littleIx
where
len :: Int
len :: Int
len = ByteString -> Int
BS.length ByteString
bs
{-# INLINEABLE writeBits #-}
writeBits :: ByteString -> [Integer] -> Bool -> BuiltinResult ByteString
writeBits :: ByteString -> [Integer] -> Bool -> BuiltinResult ByteString
writeBits ByteString
bs [Integer]
ixs Bool
bit = case IO (Either WriteBitsException ByteString)
-> Either WriteBitsException ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either WriteBitsException ByteString)
-> Either WriteBitsException ByteString)
-> (IO ByteString -> IO (Either WriteBitsException ByteString))
-> IO ByteString
-> Either WriteBitsException ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> IO (Either WriteBitsException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> Either WriteBitsException ByteString)
-> IO ByteString -> Either WriteBitsException ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString
go of
Left (WriteBitsException Integer
i) -> do
Text -> BuiltinResult ()
emit Text
"writeBits: index out of bounds"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Index: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
i)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
Right ByteString
result -> ByteString -> BuiltinResult ByteString
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
result
where
go :: IO ByteString
go :: IO ByteString
go = ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
bs ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcPtr ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
\Ptr Word8
dstPtr ->
let go2 :: [Integer] -> IO ()
go2 (Integer
i:[Integer]
is) = Ptr Word8 -> Integer -> IO ()
setOrClearAtIx Ptr Word8
dstPtr Integer
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Integer] -> IO ()
go2 [Integer]
is
go2 [Integer]
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
in do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr) Int
len
[Integer] -> IO ()
go2 [Integer]
ixs
len :: Int
len :: Int
len = ByteString -> Int
BS.length ByteString
bs
bitLen :: Integer
bitLen :: Integer
bitLen = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8
setOrClearAtIx :: Ptr Word8 -> Integer -> IO ()
setOrClearAtIx :: Ptr Word8 -> Integer -> IO ()
setOrClearAtIx Ptr Word8
ptr Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = WriteBitsException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WriteBitsException -> IO ()) -> WriteBitsException -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> WriteBitsException
WriteBitsException Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
bitLen = WriteBitsException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WriteBitsException -> IO ()) -> WriteBitsException -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> WriteBitsException
WriteBitsException Integer
i
| Bool
otherwise = do
let (Integer
bigIx, Integer
littleIx) = Integer
i Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
8
let flipIx :: Int
flipIx = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bigIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Word8
w8 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
flipIx
let toWrite :: Word8
toWrite = if Bool
bit
then Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
Bits.setBit Word8
w8 (Int -> Word8) -> (Integer -> Int) -> Integer -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Integer
littleIx
else Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
Bits.clearBit Word8
w8 (Int -> Word8) -> (Integer -> Int) -> Integer -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Integer
littleIx
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
flipIx Word8
toWrite
{-# INLINEABLE setOrClearAtIx #-}
replicateByte :: Integer -> Word8 -> BuiltinResult ByteString
replicateByte :: Integer -> Word8 -> BuiltinResult ByteString
replicateByte Integer
len Word8
w8
| Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = do
Text -> BuiltinResult ()
emit Text
"replicateByte: negative length requested"
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
| Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maximumOutputLength = do
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ())
-> ([Char] -> Text) -> [Char] -> BuiltinResult ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> BuiltinResult ()) -> [Char] -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ [Char]
"replicateByte: requested length is too long (maximum is "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
maximumOutputLength
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes)"
Text -> BuiltinResult ()
emit (Text -> BuiltinResult ()) -> Text -> BuiltinResult ()
forall a b. (a -> b) -> a -> b
$ Text
"Length requested: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
len)
BuiltinResult ByteString
forall err. AsEvaluationFailure err => err
evaluationFailure
| Bool
otherwise = ByteString -> BuiltinResult ByteString
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> BuiltinResult ByteString)
-> (Word8 -> ByteString) -> Word8 -> BuiltinResult ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
BS.replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len) (Word8 -> BuiltinResult ByteString)
-> Word8 -> BuiltinResult ByteString
forall a b. (a -> b) -> a -> b
$ Word8
w8
shiftByteString :: ByteString -> Integer -> ByteString
shiftByteString :: ByteString -> Integer -> ByteString
shiftByteString ByteString
bs Integer
bitMove
| ByteString -> Bool
BS.null ByteString
bs = ByteString
bs
| Integer
bitMove Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = ByteString
bs
| Bool
otherwise = let len :: Int
len = ByteString -> Int
BS.length ByteString
bs
bitLen :: Integer
bitLen = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
in if Integer -> Integer
forall a. Num a => a -> a
abs Integer
bitMove Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
bitLen
then Int -> Word8 -> ByteString
BS.replicate Int
len Word8
0x00
else ByteString -> Int -> ByteString
unsafeShiftByteString ByteString
bs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bitMove)
rotateByteString :: ByteString -> Integer -> ByteString
rotateByteString :: ByteString -> Integer -> ByteString
rotateByteString ByteString
bs Integer
bitMove
| ByteString -> Bool
BS.null ByteString
bs = ByteString
bs
| Bool
otherwise = let bitLen :: Integer
bitLen = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ByteString -> Int
BS.length ByteString
bs
reducedBitMove :: Integer
reducedBitMove = Integer
bitMove Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
bitLen
in if Integer
reducedBitMove Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
then ByteString
bs
else ByteString -> Int -> ByteString
unsafeRotateByteString ByteString
bs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
reducedBitMove)
unsafeShiftByteString :: ByteString -> Int -> ByteString
unsafeShiftByteString :: ByteString -> Int -> ByteString
unsafeShiftByteString ByteString
bs Int
bitMove = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
bs ((Ptr CChar -> IO ByteString) -> ByteString)
-> (Ptr CChar -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcPtr ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
let magnitude :: Int
magnitude = Int -> Int
forall a. Num a => a -> a
abs Int
bitMove
Ptr Word8 -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Word8
dstPtr Word8
0x00 Int
len
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
magnitude Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bitLen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let (Int
bigShift, Int
smallShift) = Int
magnitude Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
case Int -> Int
forall a. Num a => a -> a
signum Int
bitMove of
(-1) -> Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
negativeShift (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr) Ptr Word8
dstPtr Int
bigShift Int
smallShift
Int
_ -> Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
positiveShift (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr) Ptr Word8
dstPtr Int
bigShift Int
smallShift
where
len :: Int
!len :: Int
len = ByteString -> Int
BS.length ByteString
bs
bitLen :: Int
!bitLen :: Int
bitLen = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
negativeShift :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
negativeShift :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
negativeShift Ptr Word8
srcPtr Ptr Word8
dstPtr Int
bigShift Int
smallShift = do
let copyDstPtr :: Ptr b
copyDstPtr = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
bigShift
let copyLen :: Int
copyLen = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bigShift
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
forall {b}. Ptr b
copyDstPtr Ptr Word8
srcPtr Int
copyLen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
smallShift Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let !invSmallShift :: Int
invSmallShift = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smallShift
let !mask :: Word8
mask = Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
invSmallShift
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
copyLen] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
byteIx -> do
!(Word8
currentByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr Int
byteIx
!(Word8
prevByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
let !prevOverflowBits :: Word8
prevOverflowBits = Word8
prevByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..&. Word8
mask
let !newCurrentByte :: Word8
newCurrentByte =
(Word8
currentByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
smallShift)
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..|. (Word8
prevOverflowBits Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
invSmallShift)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr Int
byteIx Word8
newCurrentByte
!(Word8
firstByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
copyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
copyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8
firstByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
smallShift)
positiveShift :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
positiveShift :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
positiveShift Ptr Word8
srcPtr Ptr Word8
dstPtr Int
bigShift Int
smallShift = do
let copySrcPtr :: Ptr b
copySrcPtr = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
srcPtr Int
bigShift
let copyLen :: Int
copyLen = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bigShift
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr Ptr Word8
forall {b}. Ptr b
copySrcPtr Int
copyLen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
smallShift Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let !invSmallShift :: Int
invSmallShift = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smallShift
let !mask :: Word8
mask = Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
invSmallShift
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0, Int
1 .. Int
copyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
byteIx -> do
!(Word8
currentByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr Int
byteIx
!(Word8
nextByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let !nextOverflowBits :: Word8
nextOverflowBits = Word8
nextByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..&. Word8
mask
let !newCurrentByte :: Word8
newCurrentByte =
(Word8
currentByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
smallShift)
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..|. (Word8
nextOverflowBits Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
invSmallShift)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr Int
byteIx Word8
newCurrentByte
!(Word8
lastByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
copyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr (Int
copyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8
lastByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
smallShift)
unsafeRotateByteString :: ByteString -> Int -> ByteString
unsafeRotateByteString :: ByteString -> Int -> ByteString
unsafeRotateByteString ByteString
bs Int
bitMove = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
bs ((Ptr CChar -> IO ByteString) -> ByteString)
-> (Ptr CChar -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcPtr ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BSI.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr -> do
let (Int
bigRotation, Int
smallRotation) = Int
bitMove Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
8
Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
go (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr) Ptr Word8
dstPtr Int
bigRotation Int
smallRotation
where
len :: Int
!len :: Int
len = ByteString -> Int
BS.length ByteString
bs
go :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
go :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()
go Ptr Word8
srcPtr Ptr Word8
dstPtr Int
bigRotate Int
smallRotate = do
let copyStartSrcPtr :: Ptr b
copyStartSrcPtr = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
srcPtr Int
bigRotate
let copyStartLen :: Int
copyStartLen = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bigRotate
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
dstPtr Ptr Word8
forall {b}. Ptr b
copyStartSrcPtr Int
copyStartLen
let copyEndDstPtr :: Ptr b
copyEndDstPtr = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dstPtr Int
copyStartLen
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
forall {b}. Ptr b
copyEndDstPtr Ptr Word8
srcPtr Int
bigRotate
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
smallRotate Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let !invSmallRotate :: Int
invSmallRotate = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
smallRotate
let !mask :: Word8
mask = Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
invSmallRotate
!(Word8
cloneFirstByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr Int
0
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0, Int
1 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
byteIx -> do
!(Word8
currentByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr Int
byteIx
!(Word8
nextByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let !nextOverflowBits :: Word8
nextOverflowBits = Word8
nextByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..&. Word8
mask
let !newCurrentByte :: Word8
newCurrentByte =
(Word8
currentByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
smallRotate)
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..|. (Word8
nextOverflowBits Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
invSmallRotate)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr Int
byteIx Word8
newCurrentByte
!(Word8
lastByte :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dstPtr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
let !firstOverflowBits :: Word8
firstOverflowBits = Word8
cloneFirstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..&. Word8
mask
let !newLastByte :: Word8
newLastByte =
(Word8
lastByte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftL` Int
smallRotate)
Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits..|. (Word8
firstOverflowBits Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.unsafeShiftR` Int
invSmallRotate)
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dstPtr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
newLastByte
countSetBits :: ByteString -> Int
countSetBits :: ByteString -> Int
countSetBits ByteString
bs = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int)
-> ((Ptr CChar -> IO Int) -> IO Int)
-> (Ptr CChar -> IO Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Ptr CChar -> IO Int) -> IO Int
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
bs ((Ptr CChar -> IO Int) -> Int) -> (Ptr CChar -> IO Int) -> Int
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcPtr -> do
let Ptr Word64
bigSrcPtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr
let Ptr Word8
smallSrcPtr :: Ptr Word8 = Ptr CChar -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
srcPtr Int
offset
Ptr Word64 -> Ptr Word8 -> Int -> Int -> IO Int
goBig Ptr Word64
bigSrcPtr Ptr Word8
smallSrcPtr Int
0 Int
0
where
len :: Int
!len :: Int
len = ByteString -> Int
BS.length ByteString
bs
bigStrides :: Int
!bigStrides :: Int
bigStrides = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
smallStrides :: Int
!smallStrides :: Int
smallStrides = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8
offset :: Int
!offset :: Int
offset = Int
bigStrides Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
goBig :: Ptr Word64 -> Ptr Word8 -> Int -> Int -> IO Int
goBig :: Ptr Word64 -> Ptr Word8 -> Int -> Int -> IO Int
goBig !Ptr Word64
bigSrcPtr !Ptr Word8
smallSrcPtr !Int
acc !Int
bigIx
| Int
bigIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bigStrides = Ptr Word8 -> Int -> Int -> IO Int
goSmall Ptr Word8
smallSrcPtr Int
acc Int
0
| Bool
otherwise = do
!Word64
w64 <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
bigSrcPtr Int
bigIx
Ptr Word64 -> Ptr Word8 -> Int -> Int -> IO Int
goBig Ptr Word64
bigSrcPtr Ptr Word8
smallSrcPtr (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a. Bits a => a -> Int
Bits.popCount Word64
w64) (Int
bigIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
goSmall :: Ptr Word8 -> Int -> Int -> IO Int
goSmall :: Ptr Word8 -> Int -> Int -> IO Int
goSmall !Ptr Word8
smallSrcPtr !Int
acc !Int
smallIx
| Int
smallIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smallStrides = Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
acc
| Bool
otherwise = do
!Word8
w8 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
smallSrcPtr Int
smallIx
Ptr Word8 -> Int -> Int -> IO Int
goSmall Ptr Word8
smallSrcPtr (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a. Bits a => a -> Int
Bits.popCount Word8
w8) (Int
smallIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
findFirstSetBit :: ByteString -> Int
findFirstSetBit :: ByteString -> Int
findFirstSetBit ByteString
bs = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int)
-> ((Ptr CChar -> IO Int) -> IO Int)
-> (Ptr CChar -> IO Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Ptr CChar -> IO Int) -> IO Int
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
bs ((Ptr CChar -> IO Int) -> Int) -> (Ptr CChar -> IO Int) -> Int
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcPtr -> do
let Ptr Word64
bigSrcPtr :: Ptr Word64 = Ptr CChar -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
srcPtr
Ptr Word64 -> Int -> Int -> IO Int
goBig Ptr Word64
bigSrcPtr Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
where
goBig :: Ptr Word64 -> Int -> Int -> IO Int
goBig :: Ptr Word64 -> Int -> Int -> IO Int
goBig !Ptr Word64
bigSrcPtr !Int
acc !Int
byteIx
| Int
byteIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = do
!(Word64
w64 :: Word64) <- Ptr Word64 -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word64
bigSrcPtr Int
byteIx
if Word64
w64 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x0
then Ptr Word64 -> Int -> Int -> IO Int
goBig Ptr Word64
bigSrcPtr (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
else Ptr Word8 -> Int -> Int -> IO Int
goSmall (Ptr Word64 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
bigSrcPtr) Int
acc (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
| Int
byteIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Int
8) = Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)
| Bool
otherwise = Ptr Word8 -> Int -> Int -> IO Int
goSmall (Ptr Word64 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
bigSrcPtr) Int
acc (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
goSmall :: Ptr Word8 -> Int -> Int -> IO Int
goSmall :: Ptr Word8 -> Int -> Int -> IO Int
goSmall !Ptr Word8
smallSrcPtr !Int
acc !Int
byteIx
| Int
byteIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)
| Bool
otherwise = do
!(Word8
w8 :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
smallSrcPtr Int
byteIx
let !counted :: Int
counted = Word8 -> Int
forall b. FiniteBits b => b -> Int
Bits.countTrailingZeros Word8
w8
let !newAcc :: Int
newAcc = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
counted
if Int
counted Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
then Ptr Word8 -> Int -> Int -> IO Int
goSmall Ptr Word8
smallSrcPtr Int
newAcc (Int
byteIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
newAcc
len :: Int
!len :: Int
len = ByteString -> Int
BS.length ByteString
bs
newtype WriteBitsException = WriteBitsException Integer
deriving stock (WriteBitsException -> WriteBitsException -> Bool
(WriteBitsException -> WriteBitsException -> Bool)
-> (WriteBitsException -> WriteBitsException -> Bool)
-> Eq WriteBitsException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteBitsException -> WriteBitsException -> Bool
== :: WriteBitsException -> WriteBitsException -> Bool
$c/= :: WriteBitsException -> WriteBitsException -> Bool
/= :: WriteBitsException -> WriteBitsException -> Bool
Eq, Int -> WriteBitsException -> [Char] -> [Char]
[WriteBitsException] -> [Char] -> [Char]
WriteBitsException -> [Char]
(Int -> WriteBitsException -> [Char] -> [Char])
-> (WriteBitsException -> [Char])
-> ([WriteBitsException] -> [Char] -> [Char])
-> Show WriteBitsException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> WriteBitsException -> [Char] -> [Char]
showsPrec :: Int -> WriteBitsException -> [Char] -> [Char]
$cshow :: WriteBitsException -> [Char]
show :: WriteBitsException -> [Char]
$cshowList :: [WriteBitsException] -> [Char] -> [Char]
showList :: [WriteBitsException] -> [Char] -> [Char]
Show)
instance Exception WriteBitsException