-- | Blobs are raw data in continuous regions of memory.
--
-- This library provides a type for blobs consisting 64 bit words 
-- which is optimized for small sizes. They take:
--
-- * only 1 extra word up for blobs of size up to 48 bytes (that is, up to 6 @Word64@-s);
--
-- * but (unfortunataly) 4 extra words above that.
--
-- (This particular tradeoff was chosen so that pointer tagging still
-- works on 64 bit architectures: there are 7 constructors of the data type.)
--
-- The 'Blob' data type is useful if you want to store large amounts of small,
-- serialized data. Some example use cases:
--
--  * small vectors of small nonnegative integers (for example: partitions, permutations, monomials)
-- 
--  * cryptographic hashes 
--
--  * tables indexed by such things
--

{-# LANGUAGE CPP, BangPatterns, MagicHash, ForeignFunctionInterface #-}
module Data.Vector.Compact.Blob 
  (
    -- * The Blob type
    Blob(..)
  , blobTag
  , blobSizeInWords
  , blobSizeInBytes
  , blobSizeInBits
    -- * Conversion to\/from lists
  , blobFromWordList , blobFromWordListN
  , blobToWordList
    -- * Conversion to\/from 'ByteArray'-s
  , blobFromByteArray
  , blobToByteArray
    -- * Equality comparison
  , eqBlob
    -- * Head, tail, cons, etc  
  , head
  , tail
  , last
  , consWord
  , snocWord
    -- * Indexing
  , indexWord , indexByte
  , extractSmallWord , extractSmallWord64
    -- * Resizing
  , extendToSize
  , cutToSize
  , forceToSize
    -- * Higher-order functions
  , mapBlob
  , shortZipWith
  , longZipWith
  , unsafeZipWith
    -- * Hexadecimal printing
  , Hex(..)
  , hexWord64 , hexWord64_
    -- * (Indirect) access to the raw data
    --
    -- $raw
  , peekBlob
  , pokeBlob
    -- * Wrappers for C implementations
    --
    -- $wrapper
  , CFun10 , CFun20 , CFun11 , CFun21 , CFun11_ , CFun21_
  , wrapCFun10 , wrapCFun20 , wrapCFun11 , wrapCFun21 , wrapCFun11_ , wrapCFun21_
  )
  where

--------------------------------------------------------------------------------

import Prelude hiding ( head , tail , last )
import Data.Char
import Data.Bits
import Data.Int
import Data.Word
import qualified Data.List as L

import Control.Monad
import Control.Monad.ST

import GHC.Int
import GHC.Word
import GHC.Ptr
import GHC.Exts
import GHC.IO

import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal
import Foreign.Marshal.Array

import System.IO.Unsafe as Unsafe

import Control.Monad.Primitive
import Data.Primitive.ByteArray

--------------------------------------------------------------------------------
-- * the Blob type

-- | A 'Blob' is a nonempty array of 'Word64'-s.
-- For arrays of length at most 6 (that is, at most 48 bytes), there is only a single
-- machine word overhead in memory consumption. For larger arrays, there is 4 words of overhead.
--  
data Blob
  = Blob1 {-# UNPACK #-} !Word64
  | Blob2 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  | Blob3 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  | Blob4 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  | Blob5 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  | Blob6 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  | BlobN {-# UNPACK #-} !ByteArray 

--------------------------------------------------------------------------------

blobTag :: Blob -> Int
blobTag :: Blob -> Int
blobTag Blob
blob = Int# -> Int
I# (Blob -> Int#
forall a. a -> Int#
dataToTag# Blob
blob)

-- | Number of 'Word64'-s
blobSizeInWords :: Blob -> Int
blobSizeInWords :: Blob -> Int
blobSizeInWords !Blob
blob = case Blob
blob of
  BlobN !ByteArray
arr -> Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (ByteArray -> Int
sizeofByteArray ByteArray
arr) Int
3
  Blob
otherwise  -> Blob -> Int
blobTag Blob
blob Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

blobSizeInBytes :: Blob -> Int
blobSizeInBytes :: Blob -> Int
blobSizeInBytes !Blob
blob = case Blob
blob of
  BlobN !ByteArray
arr -> ByteArray -> Int
sizeofByteArray ByteArray
arr
  Blob
otherwise  -> Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Blob -> Int
blobTag Blob
blob Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
3

blobSizeInBits :: Blob -> Int
blobSizeInBits :: Blob -> Int
blobSizeInBits Blob
blob = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Blob -> Int
blobSizeInBytes Blob
blob) Int
3
    
--------------------------------------------------------------------------------
-- * Conversion to\/from lists

blobFromWordList :: [Word64] -> Blob
blobFromWordList :: [Word64] -> Blob
blobFromWordList [Word64]
ws = Int -> [Word64] -> Blob
blobFromWordListN ([Word64] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
ws) [Word64]
ws
  
blobFromWordListN :: Int -> [Word64] -> Blob  
blobFromWordListN :: Int -> [Word64] -> Blob
blobFromWordListN !Int
n [Word64]
ws = case Int
n of
  Int
0 -> Word64 -> Blob
Blob1 Word64
0
  Int
1 -> case [Word64]
ws of { (Word64
a:[Word64]
_)            -> Word64 -> Blob
Blob1 Word64
a           }
  Int
2 -> case [Word64]
ws of { (Word64
a:Word64
b:[Word64]
_)          -> Word64 -> Word64 -> Blob
Blob2 Word64
a Word64
b         }
  Int
3 -> case [Word64]
ws of { (Word64
a:Word64
b:Word64
c:[Word64]
_)        -> Word64 -> Word64 -> Word64 -> Blob
Blob3 Word64
a Word64
b Word64
c       }
  Int
4 -> case [Word64]
ws of { (Word64
a:Word64
b:Word64
c:Word64
d:[Word64]
_)      -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 Word64
a Word64
b Word64
c Word64
d     }
  Int
5 -> case [Word64]
ws of { (Word64
a:Word64
b:Word64
c:Word64
d:Word64
e:[Word64]
_)    -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   }
  Int
6 -> case [Word64]
ws of { (Word64
a:Word64
b:Word64
c:Word64
d:Word64
e:Word64
f:[Word64]
_)  -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f }
  Int
_ -> ByteArray -> Blob
BlobN (Int -> [Word64] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN Int
n [Word64]
ws)
  
blobToWordList :: Blob -> [Word64]
blobToWordList :: Blob -> [Word64]
blobToWordList Blob
blob = case Blob
blob of
  Blob1 Word64
a           -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  Blob2 Word64
a Word64
b         -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
bWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  Blob3 Word64
a Word64
b Word64
c       -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
bWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
cWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  Blob4 Word64
a Word64
b Word64
c Word64
d     -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
bWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
cWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
dWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
bWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
cWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
dWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
eWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f -> Word64
aWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
bWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
cWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
dWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
eWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:Word64
fWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:[]
  BlobN ByteArray
ba          -> (Word64 -> [Word64] -> [Word64])
-> [Word64] -> ByteArray -> [Word64]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray (:) [] ByteArray
ba

--------------------------------------------------------------------------------
-- * Conversion to\/from @ByteArray@-s

-- | Note: we pad the input with zero bytes, assuming little-endian architecture.
blobFromByteArray :: ByteArray -> Blob
blobFromByteArray :: ByteArray -> Blob
blobFromByteArray !ByteArray
ba
  | Int
nwords Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
6  = if Int
nwords1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nwords
                     then ByteArray -> Blob
BlobN ByteArray
ba
                     else ByteArray -> Blob
BlobN (Int -> [Word64] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN Int
nwords [Word64]
words )
  | Int
nwords Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Word64 -> Blob
Blob1 Word64
0
  | Bool
otherwise    = Int -> [Word64] -> Blob
blobFromWordListN Int
nwords [Word64]
words
  where
    !nbytes :: Int
nbytes  = ByteArray -> Int
sizeofByteArray ByteArray
ba
    !nwords1 :: Int
nwords1 = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
nbytes    ) Int
3 
    !nwords :: Int
nwords  = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
nbytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int
3

    words :: [Word64]
    words :: [Word64]
words = if Int
nwords1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nwords
      then (Word64 -> [Word64] -> [Word64])
-> [Word64] -> ByteArray -> [Word64]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray (:) [] ByteArray
ba  
      else let !ofs :: Int
ofs = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
nwords1 Int
3
               !m :: Int
m =   Int
nbytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ofs
               w8_to_w64 :: Word8 -> Word64
               w8_to_w64 :: Word8 -> Word64
w8_to_w64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
               !lastWord :: Word64
lastWord = (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) Word64
0 
                         [ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
w8_to_w64 (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i))) (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
i Int
3) 
                         | Int
i<-[Int
0..Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] 
                         ]
           in  (Word64 -> [Word64] -> [Word64])
-> [Word64] -> ByteArray -> [Word64]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray (:) [Word64
lastWord] ByteArray
ba

blobToByteArray :: Blob -> ByteArray
blobToByteArray :: Blob -> ByteArray
blobToByteArray !Blob
blob = case Blob
blob of
  BlobN ByteArray
ba  -> ByteArray
ba
  Blob
_         -> Int -> [Word64] -> ByteArray
forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN (Blob -> Int
blobSizeInWords Blob
blob) (Blob -> [Word64]
blobToWordList Blob
blob)

--------------------------------------------------------------------------------
-- * Instances
  
instance Show Blob where
  showsPrec :: Int -> Blob -> ShowS
showsPrec Int
prec !Blob
blob 
    = Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) 
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"blobFromWordList " 
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Hex] -> ShowS
forall a. Show a => a -> ShowS
shows ((Word64 -> Hex) -> [Word64] -> [Hex]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Hex
Hex ([Word64] -> [Hex]) -> [Word64] -> [Hex]
forall a b. (a -> b) -> a -> b
$ Blob -> [Word64]
blobToWordList Blob
blob)

instance Eq Blob where
  == :: Blob -> Blob -> Bool
(==) = Blob -> Blob -> Bool
eqBlob

eqBlob :: Blob -> Blob -> Bool  
eqBlob :: Blob -> Blob -> Bool
eqBlob !Blob
x !Blob
y = if Blob -> Int
blobTag Blob
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Blob -> Int
blobTag Blob
y 
  then Bool
False 
  else case (Blob
x,Blob
y) of
    ( Blob1 Word64
a           , Blob1 Word64
p           ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p
    ( Blob2 Word64
a Word64
b         , Blob2 Word64
p Word64
q         ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p Bool -> Bool -> Bool
&& Word64
bWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
q
    ( Blob3 Word64
a Word64
b Word64
c       , Blob3 Word64
p Word64
q Word64
r       ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p Bool -> Bool -> Bool
&& Word64
bWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
q Bool -> Bool -> Bool
&& Word64
cWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
r
    ( Blob4 Word64
a Word64
b Word64
c Word64
d     , Blob4 Word64
p Word64
q Word64
r Word64
s     ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p Bool -> Bool -> Bool
&& Word64
bWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
q Bool -> Bool -> Bool
&& Word64
cWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
r Bool -> Bool -> Bool
&& Word64
dWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
s
    ( Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   , Blob5 Word64
p Word64
q Word64
r Word64
s Word64
t   ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p Bool -> Bool -> Bool
&& Word64
bWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
q Bool -> Bool -> Bool
&& Word64
cWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
r Bool -> Bool -> Bool
&& Word64
dWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
s Bool -> Bool -> Bool
&& Word64
eWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
t
    ( Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f , Blob6 Word64
p Word64
q Word64
r Word64
s Word64
t Word64
u ) -> Word64
aWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
p Bool -> Bool -> Bool
&& Word64
bWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
q Bool -> Bool -> Bool
&& Word64
cWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
r Bool -> Bool -> Bool
&& Word64
dWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
s Bool -> Bool -> Bool
&& Word64
eWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
t Bool -> Bool -> Bool
&& Word64
fWord64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==Word64
u
    ( BlobN ByteArray
one         , BlobN ByteArray
two         ) -> ByteArray
one ByteArray -> ByteArray -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray
two     
    (Blob, Blob)
_                                         -> String -> Bool
forall a. HasCallStack => String -> a
error String
"FATAL ERROR: should not happen"

--------------------------------------------------------------------------------
-- * Hexadecimal printing
  
newtype Hex 
  = Hex Word64 

instance Show Hex where 
  show :: Hex -> String
show (Hex Word64
w) = Word64 -> String
hexWord64 Word64
w 

hexWord64 :: Word64 -> String
hexWord64 :: Word64 -> String
hexWord64 Word64
word= Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'x' Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> String
hexWord64_ Word64
word 

hexWord64_ :: Word64 -> String
hexWord64_ :: Word64 -> String
hexWord64_ Word64
word = String -> Integer -> Word64 -> String
forall t t.
(Integral t, Bits t, Num t, Eq t) =>
String -> t -> t -> String
go [] Integer
16 Word64
word where
  
  go :: String -> t -> t -> String
go !String
acc  t
0 !t
w = String
acc 
  go !String
acc !t
k !t
w = String -> t -> t -> String
go (t -> Char
forall a. Integral a => a -> Char
hexNibble (t
w t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
15) Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) (t
kt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (t -> Int -> t
forall a. Bits a => a -> Int -> a
shiftR t
w Int
4) 
  
  hexNibble :: Integral a => a -> Char
  hexNibble :: a -> Char
hexNibble a
i0 = let i :: Int
i = (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i0 :: Int) in if (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10) then Int -> Char
chr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
48) else Int -> Char
chr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
87)
      
--------------------------------------------------------------------------------
-- * Peek
 
indexWord :: Blob -> Int -> Word64
indexWord :: Blob -> Int -> Word64
indexWord !Blob
blob !Int
idx = case Blob
blob of

  Blob1 Word64
a  
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  Blob2 Word64
a Word64
b
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -> Word64
b
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  Blob3 Word64
a Word64
b Word64
c
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -> Word64
b
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2   -> Word64
c
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  Blob4 Word64
a Word64
b Word64
c Word64
d 
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -> Word64
b
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2   -> Word64
c
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3   -> Word64
d
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e 
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -> Word64
b
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2   -> Word64
c
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3   -> Word64
d
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4   -> Word64
e
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Word64
a
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -> Word64
b
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2   -> Word64
c
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3   -> Word64
d
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4   -> Word64
e
    | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5   -> Word64
f
    | Bool
otherwise  -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/indexWord: index out of bounds"

  BlobN ByteArray
arr -> ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
idx
 
-- | NOTE: We assume a little-endian architecture here.
-- Though it seems that since GHC does not gives us direct access to the closure,
-- it doesn\'t matter after all...
--  
indexByte :: Blob -> Int -> Word8
indexByte :: Blob -> Int -> Word8
indexByte !Blob
blob !Int
idx =
  let !w :: Word64
w = Blob -> Int -> Word64
indexWord Blob
blob (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
idx Int
3)
  in  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
idx Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
7))

--------------------------------------------------------------------------------
-- * Head and last

head :: Blob -> Word64
head :: Blob -> Word64
head Blob
blob = case Blob
blob of
  Blob1 Word64
a             -> Word64
a
  Blob2 Word64
a Word64
_           -> Word64
a
  Blob3 Word64
a Word64
_ Word64
_         -> Word64
a
  Blob4 Word64
a Word64
_ Word64
_ Word64
_       -> Word64
a
  Blob5 Word64
a Word64
_ Word64
_ Word64
_ Word64
_     -> Word64
a
  Blob6 Word64
a Word64
_ Word64
_ Word64
_ Word64
_ Word64
_   -> Word64
a
  BlobN ByteArray
arr           -> ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
0

last :: Blob -> Word64
last :: Blob -> Word64
last Blob
blob = case Blob
blob of
  Blob1 Word64
z             -> Word64
z
  Blob2 Word64
_ Word64
z           -> Word64
z
  Blob3 Word64
_ Word64
_ Word64
z         -> Word64
z
  Blob4 Word64
_ Word64
_ Word64
_ Word64
z       -> Word64
z
  Blob5 Word64
_ Word64
_ Word64
_ Word64
_ Word64
z     -> Word64
z
  Blob6 Word64
_ Word64
_ Word64
_ Word64
_ Word64
_ Word64
z   -> Word64
z
  BlobN ByteArray
arr           -> ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (Blob -> Int
blobSizeInWords Blob
blob Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

--------------------------------------------------------------------------------
-- * Cons, Snoc, tail

-- | Prepend a word at the start
consWord :: Word64 -> Blob -> Blob
consWord :: Word64 -> Blob -> Blob
consWord !Word64
y !Blob
blob = case Blob
blob of
  Blob1 Word64
a           -> Word64 -> Word64 -> Blob
Blob2 Word64
y Word64
a
  Blob2 Word64
a Word64
b         -> Word64 -> Word64 -> Word64 -> Blob
Blob3 Word64
y Word64
a Word64
b
  Blob3 Word64
a Word64
b Word64
c       -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 Word64
y Word64
a Word64
b Word64
c
  Blob4 Word64
a Word64
b Word64
c Word64
d     -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 Word64
y Word64
a Word64
b Word64
c Word64
d
  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 Word64
y Word64
a Word64
b Word64
c Word64
d Word64
e
  Blob
_                 -> CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (Word64 -> CFun11_
c_cons Word64
y) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Blob
blob

-- | Append a word at the end
snocWord :: Blob -> Word64 -> Blob
snocWord :: Blob -> Word64 -> Blob
snocWord !Blob
blob !Word64
z = case Blob
blob of
  Blob1 Word64
a           -> Word64 -> Word64 -> Blob
Blob2 Word64
a Word64
z
  Blob2 Word64
a Word64
b         -> Word64 -> Word64 -> Word64 -> Blob
Blob3 Word64
a Word64
b Word64
z
  Blob3 Word64
a Word64
b Word64
c       -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 Word64
a Word64
b Word64
c Word64
z
  Blob4 Word64
a Word64
b Word64
c Word64
d     -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 Word64
a Word64
b Word64
c Word64
d Word64
z
  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
z
  Blob
_                 -> CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (Word64 -> CFun11_
c_snoc Word64
z) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Blob
blob

-- | Remove the first word
tail :: Blob -> Blob 
tail :: Blob -> Blob
tail !Blob
blob = case Blob
blob of
  Blob1 Word64
_           -> Word64 -> Blob
Blob1 Word64
0
  Blob2 Word64
_ Word64
b         -> Word64 -> Blob
Blob1 Word64
b 
  Blob3 Word64
_ Word64
b Word64
c       -> Word64 -> Word64 -> Blob
Blob2 Word64
b Word64
c
  Blob4 Word64
_ Word64
b Word64
c Word64
d     -> Word64 -> Word64 -> Word64 -> Blob
Blob3 Word64
b Word64
c Word64
d 
  Blob5 Word64
_ Word64
b Word64
c Word64
d Word64
e   -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 Word64
b Word64
c Word64
d Word64
e 
  Blob6 Word64
_ Word64
b Word64
c Word64
d Word64
e Word64
f -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 Word64
b Word64
c Word64
d Word64
e Word64
f 
  Blob
_                 -> CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ CFun11_
c_tail Int -> Int
forall a. a -> a
id Blob
blob

--------------------------------------------------------------------------------

-- | @extractSmallWord n blob ofs@ extracts a small word of @n@ bits starting from the
-- @ofs@-th bit. This should satisfy
--
-- > testBit (extractSmallWord n blob ofs) i == testBit blob (ofs+i)  
--
-- NOTE: we assume that @n@ is at most the bits in 'Word', and that @ofs+n@ is less
-- than the size (in bits) of the blob.
--
extractSmallWord :: Integral a => Int -> Blob -> Int -> a
extractSmallWord :: Int -> Blob -> Int -> a
extractSmallWord !Int
n !Blob
blob !Int
ofs = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Blob -> Int -> Word64
extractSmallWord64 Int
n Blob
blob Int
ofs)

extractSmallWord64 :: Int -> Blob -> Int -> Word64 
extractSmallWord64 :: Int -> Blob -> Int -> Word64
extractSmallWord64 !Int
n !Blob
blob !Int
ofs
  | Int
q2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
q1     = Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.  Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Blob -> Int -> Word64
indexWord Blob
blob Int
q1) Int
r1
  | Int
q2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
q1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Blob -> Int -> Word64
indexWord Blob
blob Int
q1) Int
r1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Blob -> Int -> Word64
indexWord Blob
blob Int
q2) (Int
64Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r1))
  | Bool
otherwise    = String -> Word64
forall a. HasCallStack => String -> a
error String
"Blob/extractSmallWord: FATAL ERROR"
  where
    !mask :: Word64
mask = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
    !end :: Int
end  = Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    !q1 :: Int
q1   = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
ofs Int
6 
    !q2 :: Int
q2   = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
end Int
6 
    !r1 :: Int
r1   = Int
ofs Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
63

{-
-- | An alternate implementation using 'testBit', for testing purposes only
extractSmallWord64_naive :: Int -> Blob -> Int -> Word64     
extractSmallWord64_naive n blob ofs = sum [ shiftL 1 i | i<-[0..n-1] , testBit blob (ofs+i) ]
-}

--------------------------------------------------------------------------------
-- * (Indirect) access to the raw data
--
-- $raw
--
-- Note: Because GHC does not support direct manipulation of heap data
-- (the garbage collector can move it anytime), these involve copying.
--
pokeBlob :: Ptr Word64 -> Blob -> IO Int
pokeBlob :: Ptr Word64 -> Blob -> IO Int
pokeBlob !Ptr Word64
ptr !Blob
blob = case Blob
blob of
  Blob1 Word64
a           -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke      Ptr Word64
ptr  Word64
a             IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
  Blob2 Word64
a Word64
b         -> Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr [Word64
a,Word64
b]          IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
  Blob3 Word64
a Word64
b Word64
c       -> Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr [Word64
a,Word64
b,Word64
c]        IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
  Blob4 Word64
a Word64
b Word64
c Word64
d     -> Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr [Word64
a,Word64
b,Word64
c,Word64
d]      IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   -> Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr [Word64
a,Word64
b,Word64
c,Word64
d,Word64
e]    IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
5
  Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f -> Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr [Word64
a,Word64
b,Word64
c,Word64
d,Word64
e,Word64
f]  IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
6
  BlobN ByteArray
ba          -> let !nbytes :: Int
nbytes = ByteArray -> Int
sizeofByteArray ByteArray
ba
                       in  ByteArray -> Int -> Ptr Word64 -> Int -> IO ()
forall a. ByteArray -> Int -> Ptr a -> Int -> IO ()
myCopyByteArrayToPtr ByteArray
ba Int
0 Ptr Word64
ptr Int
nbytes  IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
nbytes Int
3)

peekBlob :: Int -> Ptr Word64 -> IO Blob
peekBlob :: Int -> Ptr Word64 -> IO Blob
peekBlob !Int
n !Ptr Word64
ptr =
  case Int
n of
    Int
0 ->                                       Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Blob
Blob1 Word64
0)
    Int
1 -> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek        Ptr Word64
ptr IO Word64 -> (Word64 -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
a             -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Blob
Blob1 Word64
a)
    Int
2 -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr Word64
ptr IO [Word64] -> ([Word64] -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
a,Word64
b]         -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Blob
Blob2 Word64
a Word64
b)
    Int
3 -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr Word64
ptr IO [Word64] -> ([Word64] -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
a,Word64
b,Word64
c]       -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Blob
Blob3 Word64
a Word64
b Word64
c)
    Int
4 -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr Word64
ptr IO [Word64] -> ([Word64] -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
a,Word64
b,Word64
c,Word64
d]     -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 Word64
a Word64
b Word64
c Word64
d)
    Int
5 -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
5 Ptr Word64
ptr IO [Word64] -> ([Word64] -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
a,Word64
b,Word64
c,Word64
d,Word64
e]   -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e) 
    Int
6 -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
6 Ptr Word64
ptr IO [Word64] -> ([Word64] -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
a,Word64
b,Word64
c,Word64
d,Word64
e,Word64
f] -> Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
f)
    Int
_ -> do
           MutableByteArray RealWorld
mut <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
n Int
3)
           Ptr Word64
-> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
forall a.
Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
myCopyPtrToByteArray Ptr Word64
ptr MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mut Int
0 (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
n Int
3)
           ByteArray
ba  <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mut
           Blob -> IO Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray -> Blob
BlobN ByteArray
ba)

--------------------------------------------------------------------------------
-- * Wrappers for C implementations
--
-- $wrapper
--
-- As above, these involve copying of the data (both inputs and outputs);
-- so they first allocate temporary buffers, copy the data into them
-- call the C function, and copy the result to a new 'Blob'.
--
-- Naming conventions: For example @CFun21@ means 2 Blob inputs and 1 Blob output.
--
type CFun10 a = CInt -> Ptr Word64 -> IO a
type CFun20 a = CInt -> Ptr Word64 -> CInt     -> Ptr Word64 -> IO a
type CFun11 a = CInt -> Ptr Word64 -> Ptr CInt -> Ptr Word64 -> IO a
type CFun21 a = CInt -> Ptr Word64 -> 
                CInt -> Ptr Word64 -> Ptr CInt -> Ptr Word64 -> IO a
                
type CFun11_ = CFun11 ()                
type CFun21_ = CFun21 ()                

-- | Allocate a temporary buffer, copy the content of the Blob there,
-- and call the C function
wrapCFun10_IO :: CFun10 a -> Blob -> IO a
wrapCFun10_IO :: CFun10 a -> Blob -> IO a
wrapCFun10_IO CFun10 a
action Blob
blob = do
  let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
  Int -> (Ptr Word64 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr Word64 -> IO a) -> IO a) -> (Ptr Word64 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr1 -> do
    Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr1 Blob
blob
    CFun10 a
action (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Ptr Word64
ptr1 

-- | Allocate two temporary buffers, copy the content of the two Blobs there,
-- and call the C function
wrapCFun20_IO :: CFun20 a -> Blob -> Blob -> IO a
wrapCFun20_IO :: CFun20 a -> Blob -> Blob -> IO a
wrapCFun20_IO CFun20 a
action Blob
blob1 Blob
blob2 = do
  let !n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1
  let !n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2
  Int -> (Ptr Word64 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n1 ((Ptr Word64 -> IO a) -> IO a) -> (Ptr Word64 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr1 -> do
    Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr1 Blob
blob1
    Int -> (Ptr Word64 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n2 ((Ptr Word64 -> IO a) -> IO a) -> (Ptr Word64 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr2 -> do
      Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr2 Blob
blob2
      CFun20 a
action (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n1) Ptr Word64
ptr1 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2) Ptr Word64
ptr2 
     
-- | Allocate a temporary buffer, copy the content of the Blob there (unfortunately
-- we have to do this, because the GHC runtime does not allow direct manipulation of the heap,
-- even though we /know/ the heap layout...); then allocate another temporary buffer of
-- the given length (measured in words), call the C function which can fill this second
-- buffer, finally create a new Blob from the content of the second buffer 
-- (another copying happens here).
--
wrapCFun11_IO :: CFun11 a -> Int -> Blob -> IO (a,Blob)
wrapCFun11_IO :: CFun11 a -> Int -> Blob -> IO (a, Blob)
wrapCFun11_IO CFun11 a
action Int
m Blob
blob = do
  let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
  Int -> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr1 -> do
    Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr1 Blob
blob
    Int -> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
m ((Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr2 -> do
      (Ptr CInt -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr CInt -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
q -> do
        a
y <- CFun11 a
action (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Ptr Word64
ptr1 Ptr CInt
q Ptr Word64
ptr2
        CInt
k <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
q
        Blob
new <- Int -> Ptr Word64 -> IO Blob
peekBlob (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
k) Ptr Word64
ptr2
        (a, Blob) -> IO (a, Blob)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
y,Blob
new)
        
wrapCFun21_IO :: CFun21 a -> Int -> Blob -> Blob -> IO (a,Blob)
wrapCFun21_IO :: CFun21 a -> Int -> Blob -> Blob -> IO (a, Blob)
wrapCFun21_IO CFun21 a
action Int
m Blob
blob1 Blob
blob2 = do
  let !n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1
  Int -> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n1 ((Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr1 -> do
    Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr1 Blob
blob1
    let !n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2
    Int -> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n2 ((Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr2 -> do
      Ptr Word64 -> Blob -> IO Int
pokeBlob Ptr Word64
ptr2 Blob
blob2
      Int -> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
m ((Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr Word64 -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ptr3 -> do
        (Ptr CInt -> IO (a, Blob)) -> IO (a, Blob)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (a, Blob)) -> IO (a, Blob))
-> (Ptr CInt -> IO (a, Blob)) -> IO (a, Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
q -> do
          a
y <- CFun21 a
action (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n1) Ptr Word64
ptr1 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2) Ptr Word64
ptr2 Ptr CInt
q Ptr Word64
ptr3
          CInt
k <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
q
          Blob
new <- Int -> Ptr Word64 -> IO Blob
peekBlob (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
k) Ptr Word64
ptr3
          (a, Blob) -> IO (a, Blob)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
y,Blob
new)

{-# NOINLINE wrapCFun10 #-}
wrapCFun10 :: CFun10 a -> Blob -> a
wrapCFun10 :: CFun10 a -> Blob -> a
wrapCFun10 CFun10 a
action Blob
blob = IO a -> a
forall a. IO a -> a
Unsafe.unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ CFun10 a -> Blob -> IO a
forall a. CFun10 a -> Blob -> IO a
wrapCFun10_IO CFun10 a
action Blob
blob

{-# NOINLINE wrapCFun20 #-}
wrapCFun20 :: CFun20 a -> Blob -> Blob -> a
wrapCFun20 :: CFun20 a -> Blob -> Blob -> a
wrapCFun20 CFun20 a
action Blob
blob1 Blob
blob2 = IO a -> a
forall a. IO a -> a
Unsafe.unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ CFun20 a -> Blob -> Blob -> IO a
forall a. CFun20 a -> Blob -> Blob -> IO a
wrapCFun20_IO CFun20 a
action Blob
blob1 Blob
blob2

{-# NOINLINE wrapCFun11 #-}
wrapCFun11 :: CFun11 a -> (Int -> Int) -> Blob -> (a,Blob)
wrapCFun11 :: CFun11 a -> (Int -> Int) -> Blob -> (a, Blob)
wrapCFun11 CFun11 a
action Int -> Int
f Blob
blob = IO (a, Blob) -> (a, Blob)
forall a. IO a -> a
Unsafe.unsafePerformIO (IO (a, Blob) -> (a, Blob)) -> IO (a, Blob) -> (a, Blob)
forall a b. (a -> b) -> a -> b
$ do
  let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
  CFun11 a -> Int -> Blob -> IO (a, Blob)
forall a. CFun11 a -> Int -> Blob -> IO (a, Blob)
wrapCFun11_IO CFun11 a
action (Int -> Int
f Int
n) Blob
blob

{-# NOINLINE wrapCFun11_ #-}
wrapCFun11_ :: CFun11_ -> (Int -> Int) -> Blob -> Blob 
wrapCFun11_ :: CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ CFun11_
action Int -> Int
f Blob
blob = IO Blob -> Blob
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Blob -> Blob) -> IO Blob -> Blob
forall a b. (a -> b) -> a -> b
$ do
  let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
  ((), Blob) -> Blob
forall a b. (a, b) -> b
snd (((), Blob) -> Blob) -> IO ((), Blob) -> IO Blob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFun11_ -> Int -> Blob -> IO ((), Blob)
forall a. CFun11 a -> Int -> Blob -> IO (a, Blob)
wrapCFun11_IO CFun11_
action (Int -> Int
f Int
n) Blob
blob

{-# NOINLINE wrapCFun21 #-}
wrapCFun21 :: CFun21 a -> (Int -> Int -> Int) -> Blob -> Blob -> (a,Blob)
wrapCFun21 :: CFun21 a -> (Int -> Int -> Int) -> Blob -> Blob -> (a, Blob)
wrapCFun21 CFun21 a
action Int -> Int -> Int
f Blob
blob1 Blob
blob2  = IO (a, Blob) -> (a, Blob)
forall a. IO a -> a
Unsafe.unsafePerformIO (IO (a, Blob) -> (a, Blob)) -> IO (a, Blob) -> (a, Blob)
forall a b. (a -> b) -> a -> b
$ do
  let !n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1 
  let !n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2
  CFun21 a -> Int -> Blob -> Blob -> IO (a, Blob)
forall a. CFun21 a -> Int -> Blob -> Blob -> IO (a, Blob)
wrapCFun21_IO CFun21 a
action (Int -> Int -> Int
f Int
n1 Int
n2) Blob
blob1 Blob
blob2

{-# NOINLINE wrapCFun21_ #-}
wrapCFun21_ :: CFun21_ -> (Int -> Int -> Int) -> Blob -> Blob -> Blob 
wrapCFun21_ :: CFun21_ -> (Int -> Int -> Int) -> Blob -> Blob -> Blob
wrapCFun21_ CFun21_
action Int -> Int -> Int
f Blob
blob1 Blob
blob2  = IO Blob -> Blob
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Blob -> Blob) -> IO Blob -> Blob
forall a b. (a -> b) -> a -> b
$ do
  let !n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1 
  let !n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2
  ((), Blob) -> Blob
forall a b. (a, b) -> b
snd (((), Blob) -> Blob) -> IO ((), Blob) -> IO Blob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFun21_ -> Int -> Blob -> Blob -> IO ((), Blob)
forall a. CFun21 a -> Int -> Blob -> Blob -> IO (a, Blob)
wrapCFun21_IO CFun21_
action (Int -> Int -> Int
f Int
n1 Int
n2) Blob
blob1 Blob
blob2

--------------------------------------------------------------------------------

foreign import ccall unsafe "identity" c_identity :: CFun11_       -- for testing

foreign import ccall unsafe "tail" c_tail  :: CFun11_
foreign import ccall unsafe "cons" c_cons  :: Word64 -> CFun11_
foreign import ccall unsafe "snoc" c_snoc  :: Word64 -> CFun11_

foreign import ccall unsafe "rotate_left"   c_rotate_left  :: CInt -> CFun11_
foreign import ccall unsafe "rotate_right"  c_rotate_right :: CInt -> CFun11_

foreign import ccall unsafe "shift_left_strict"    c_shift_left_strict     :: CInt -> CFun11_
foreign import ccall unsafe "shift_left_nonstrict" c_shift_left_nonstrict  :: CInt -> CFun11_
foreign import ccall unsafe "shift_right"   c_shift_right  :: CInt -> CFun11_

--------------------------------------------------------------------------------
-- * Resizing

extendToSize :: Int -> Blob -> Blob
extendToSize :: Int -> Blob -> Blob
extendToSize Int
tgt Blob
blob 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tgt   = Blob
blob
  | Bool
otherwise  = Int -> [Word64] -> Blob
blobFromWordListN Int
tgt (Blob -> [Word64]
blobToWordList Blob
blob [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> [Word64]
forall a. Int -> a -> [a]
replicate (Int
tgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Word64
0)
  where
    n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob

cutToSize :: Int -> Blob -> Blob
cutToSize :: Int -> Blob -> Blob
cutToSize Int
tgt Blob
blob 
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tgt   = Blob
blob
  | Bool
otherwise  = Int -> [Word64] -> Blob
blobFromWordListN Int
tgt (Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
tgt ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Blob -> [Word64]
blobToWordList Blob
blob)
  where
    n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob

forceToSize :: Int -> Blob -> Blob
forceToSize :: Int -> Blob -> Blob
forceToSize Int
tgt Blob
blob 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tgt   = Blob
blob
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tgt   = Int -> [Word64] -> Blob
blobFromWordListN Int
tgt (Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
tgt ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Blob -> [Word64]
blobToWordList Blob
blob)
  | Bool
otherwise  = Int -> [Word64] -> Blob
blobFromWordListN Int
tgt (Blob -> [Word64]
blobToWordList Blob
blob [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> [Word64]
forall a. Int -> a -> [a]
replicate (Int
tgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Word64
0)
  where
    n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
    
--------------------------------------------------------------------------------
-- * map and zipWith

mapBlob :: (Word64 -> Word64) -> Blob -> Blob
mapBlob :: (Word64 -> Word64) -> Blob -> Blob
mapBlob Word64 -> Word64
f !Blob
blob = case Blob
blob of
  Blob1 Word64
a           -> Word64 -> Blob
Blob1 (Word64 -> Word64
f Word64
a)
  Blob2 Word64
a Word64
b         -> Word64 -> Word64 -> Blob
Blob2 (Word64 -> Word64
f Word64
a) (Word64 -> Word64
f Word64
b)
  Blob3 Word64
a Word64
b Word64
c       -> Word64 -> Word64 -> Word64 -> Blob
Blob3 (Word64 -> Word64
f Word64
a) (Word64 -> Word64
f Word64
b) (Word64 -> Word64
f Word64
c)
  Blob4 Word64
a Word64
b Word64
c Word64
d     -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 (Word64 -> Word64
f Word64
a) (Word64 -> Word64
f Word64
b) (Word64 -> Word64
f Word64
c) (Word64 -> Word64
f Word64
d)
  Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 (Word64 -> Word64
f Word64
a) (Word64 -> Word64
f Word64
b) (Word64 -> Word64
f Word64
c) (Word64 -> Word64
f Word64
d) (Word64 -> Word64
f Word64
e)
  Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
y -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 (Word64 -> Word64
f Word64
a) (Word64 -> Word64
f Word64
b) (Word64 -> Word64
f Word64
c) (Word64 -> Word64
f Word64
d) (Word64 -> Word64
f Word64
e) (Word64 -> Word64
f Word64
y)
  BlobN ByteArray
ba          -> (forall s. ST s Blob) -> Blob
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Blob) -> Blob) -> (forall s. ST s Blob) -> Blob
forall a b. (a -> b) -> a -> b
$ do
    let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob
    MutableByteArray s
mut <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
n Int
3)
    [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mut Int
i (Word64 -> ST s ()) -> Word64 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
f (ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba Int
i)
    ByteArray
new <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mut 
    Blob -> ST s Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray -> Blob
BlobN ByteArray
new)
   
shortZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob 
shortZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
shortZipWith Word64 -> Word64 -> Word64
f !Blob
blob1 !Blob
blob2 
  | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2   = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f               Blob
blob1               Blob
blob2 
  | Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
n2   = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f (Int -> Blob -> Blob
cutToSize Int
n2 Blob
blob1)              Blob
blob2
  | Bool
otherwise  = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f               Blob
blob1 (Int -> Blob -> Blob
cutToSize Int
n1 Blob
blob2) 
  where
    n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1
    n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2

-- | Extend the shorter blob with zeros
longZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob 
longZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
longZipWith Word64 -> Word64 -> Word64
f !Blob
blob1 !Blob
blob2 
  | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2   = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f                  Blob
blob1                  Blob
blob2 
  | Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
n2   = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f (Int -> Blob -> Blob
extendToSize Int
n2 Blob
blob1)                 Blob
blob2
  | Bool
otherwise  = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f                  Blob
blob1 (Int -> Blob -> Blob
extendToSize Int
n1 Blob
blob2) 
  where
    n1 :: Int
n1 = Blob -> Int
blobSizeInWords Blob
blob1
    n2 :: Int
n2 = Blob -> Int
blobSizeInWords Blob
blob2

-- | We assume that the two blobs has the same size!
unsafeZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob 
unsafeZipWith :: (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
unsafeZipWith Word64 -> Word64 -> Word64
f !Blob
blob1 !Blob
blob2 = case (Blob
blob1,Blob
blob2) of
  ( Blob1 Word64
a           , Blob1 Word64
p           ) -> Word64 -> Blob
Blob1 (Word64 -> Word64 -> Word64
f Word64
a Word64
p)
  ( Blob2 Word64
a Word64
b         , Blob2 Word64
p Word64
q         ) -> Word64 -> Word64 -> Blob
Blob2 (Word64 -> Word64 -> Word64
f Word64
a Word64
p) (Word64 -> Word64 -> Word64
f Word64
b Word64
q)
  ( Blob3 Word64
a Word64
b Word64
c       , Blob3 Word64
p Word64
q Word64
r       ) -> Word64 -> Word64 -> Word64 -> Blob
Blob3 (Word64 -> Word64 -> Word64
f Word64
a Word64
p) (Word64 -> Word64 -> Word64
f Word64
b Word64
q) (Word64 -> Word64 -> Word64
f Word64
c Word64
r)
  ( Blob4 Word64
a Word64
b Word64
c Word64
d     , Blob4 Word64
p Word64
q Word64
r Word64
s     ) -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob4 (Word64 -> Word64 -> Word64
f Word64
a Word64
p) (Word64 -> Word64 -> Word64
f Word64
b Word64
q) (Word64 -> Word64 -> Word64
f Word64
c Word64
r) (Word64 -> Word64 -> Word64
f Word64
d Word64
s)
  ( Blob5 Word64
a Word64
b Word64
c Word64
d Word64
e   , Blob5 Word64
p Word64
q Word64
r Word64
s Word64
t   ) -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob5 (Word64 -> Word64 -> Word64
f Word64
a Word64
p) (Word64 -> Word64 -> Word64
f Word64
b Word64
q) (Word64 -> Word64 -> Word64
f Word64
c Word64
r) (Word64 -> Word64 -> Word64
f Word64
d Word64
s) (Word64 -> Word64 -> Word64
f Word64
e Word64
t)
  ( Blob6 Word64
a Word64
b Word64
c Word64
d Word64
e Word64
y , Blob6 Word64
p Word64
q Word64
r Word64
s Word64
t Word64
u ) -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Blob
Blob6 (Word64 -> Word64 -> Word64
f Word64
a Word64
p) (Word64 -> Word64 -> Word64
f Word64
b Word64
q) (Word64 -> Word64 -> Word64
f Word64
c Word64
r) (Word64 -> Word64 -> Word64
f Word64
d Word64
s) (Word64 -> Word64 -> Word64
f Word64
e Word64
t) (Word64 -> Word64 -> Word64
f Word64
y Word64
u)
  ( BlobN ByteArray
ba1         , BlobN ByteArray
ba2         ) -> 
      (forall s. ST s Blob) -> Blob
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Blob) -> Blob) -> (forall s. ST s Blob) -> Blob
forall a b. (a -> b) -> a -> b
$ do
        let !n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob1
        MutableByteArray s
mut <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
n Int
3)
        [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mut Int
i (Word64 -> ST s ()) -> Word64 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
f (ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba1 Int
i) (ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
ba2 Int
i)
        ByteArray
new <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mut 
        Blob -> ST s Blob
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray -> Blob
BlobN ByteArray
new)
  (Blob, Blob)
_ -> String -> Blob
forall a. HasCallStack => String -> a
error String
"FATAL ERROR: should not happen"

--------------------------------------------------------------------------------

-- | Implementation note: When necessary, the bitwise operations consider the blobs
-- extended to infinity with zero withs. This is especially important with 'shiftL',
-- which may /NOT/ extend the blob size if the new bits are all zero.
instance Bits Blob where
  .&. :: Blob -> Blob -> Blob
(.&.) = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
shortZipWith Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.)
  .|. :: Blob -> Blob -> Blob
(.|.) = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
longZipWith  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) 
  xor :: Blob -> Blob -> Blob
xor   = (Word64 -> Word64 -> Word64) -> Blob -> Blob -> Blob
longZipWith  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor
  complement :: Blob -> Blob
complement = (Word64 -> Word64) -> Blob -> Blob
mapBlob Word64 -> Word64
forall a. Bits a => a -> a
complement

  shiftL :: Blob -> Int -> Blob
shiftL  Blob
blob Int
k = CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (CInt -> CFun11_
c_shift_left_nonstrict (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)) Int -> Int
f  Blob
blob where f :: Int -> Int
f Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
63) Int
6
  shiftR :: Blob -> Int -> Blob
shiftR  Blob
blob Int
k = CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (CInt -> CFun11_
c_shift_right          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)) Int -> Int
forall a. a -> a
id Blob
blob
  rotateL :: Blob -> Int -> Blob
rotateL Blob
blob Int
k = CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (CInt -> CFun11_
c_rotate_left          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)) Int -> Int
forall a. a -> a
id Blob
blob
  rotateR :: Blob -> Int -> Blob
rotateR Blob
blob Int
k = CFun11_ -> (Int -> Int) -> Blob -> Blob
wrapCFun11_ (CInt -> CFun11_
c_rotate_right         (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)) Int -> Int
forall a. a -> a
id Blob
blob

#if MIN_VERSION_base(4,12,0)
  bitSizeMaybe :: Blob -> Maybe Int
bitSizeMaybe = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Blob -> Int) -> Blob -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> Int
blobSizeInBits
  bitSize :: Blob -> Int
bitSize      = Blob -> Int
blobSizeInBits
#else
  bitSize = blobSizeInBits
#endif

  zeroBits :: Blob
zeroBits = Word64 -> Blob
Blob1 Word64
0
  isSigned :: Blob -> Bool
isSigned Blob
_    = Bool
False
  popCount :: Blob -> Int
popCount Blob
blob = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ((Word64 -> Int) -> [Word64] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Int
forall a. Bits a => a -> Int
popCount ([Word64] -> [Int]) -> [Word64] -> [Int]
forall a b. (a -> b) -> a -> b
$ Blob -> [Word64]
blobToWordList Blob
blob) 

  testBit :: Blob -> Int -> Bool
testBit !Blob
blob !Int
k = if Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then Bool
False else Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Blob -> Int -> Word64
indexWord Blob
blob Int
q) Int
r where
    (Int
q,Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
k Int
64
    n :: Int
n = Blob -> Int
blobSizeInWords Blob
blob

  bit :: Int -> Blob
bit Int
k = Int -> [Word64] -> Blob
blobFromWordListN (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word64 -> [Word64]
forall a. Int -> a -> [a]
replicate Int
q Word64
0 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ [Int -> Word64
forall a. Bits a => Int -> a
bit Int
r]) where 
    (Int
q,Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
k Int
64

#if MIN_VERSION_base(4,12,0)
instance FiniteBits Blob where
  finiteBitSize :: Blob -> Int
finiteBitSize = Blob -> Int
blobSizeInBits
#endif


--------------------------------------------------------------------------------
-- * ByteArray helpers

baToList :: ByteArray -> [Word64]
baToList :: ByteArray -> [Word64]
baToList = (Word64 -> [Word64] -> [Word64])
-> [Word64] -> ByteArray -> [Word64]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
foldrByteArray (:) [] 

baSizeInWords :: ByteArray -> Int
baSizeInWords :: ByteArray -> Int
baSizeInWords ByteArray
ba = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (ByteArray -> Int
sizeofByteArray ByteArray
ba) Int
3

-- copyByteArrayToAddr# :: ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s
-- copyAddrToByteArray# :: Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s

-- | note: @n@ this is number of /bytes/. Since primitive 0.7.1.0, the same function is 
-- implemented there, but with different argument order and /number of elements/ instead.
myCopyByteArrayToPtr :: ByteArray -> Int -> Ptr a -> Int -> IO ()
myCopyByteArrayToPtr :: ByteArray -> Int -> Ptr a -> Int -> IO ()
myCopyByteArrayToPtr (ByteArray ByteArray#
ba#) (I# Int#
ofs) (Ptr Addr#
p) (I# Int#
n) = (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState IO) -> State# (PrimState IO)) -> IO ())
-> (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# Int#
ofs Addr#
p Int#
n 

myCopyPtrToByteArray :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
myCopyPtrToByteArray :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
myCopyPtrToByteArray (Ptr Addr#
p) (MutableByteArray MutableByteArray# (PrimState IO)
mut#) (I# Int#
ofs) (I# Int#
n) = (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState IO) -> State# (PrimState IO)) -> IO ())
-> (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall a b. (a -> b) -> a -> b
$ Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
p MutableByteArray# RealWorld
MutableByteArray# (PrimState IO)
mut# Int#
ofs Int#
n

--------------------------------------------------------------------------------