{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Prim
  ( primLaws
  ) where

import Control.Applicative
import Control.Monad.Primitive (PrimMonad, PrimState,primitive,primitive_)
import Control.Monad.ST
import Data.Proxy (Proxy)
import Data.Primitive.ByteArray
import Data.Primitive.Types (Prim(..))
import "primitive-addr" Data.Primitive.Addr
import Foreign.Marshal.Alloc
import GHC.Exts
  (State#,Int#,Addr#,Int(I#),(*#),(+#),(<#),newByteArray#,unsafeFreezeByteArray#,
   copyMutableByteArray#,copyByteArray#,quotInt#,sizeofByteArray#)

#if MIN_VERSION_base(4,7,0)
import GHC.Exts (IsList(fromList,toList,fromListN),Item,
  copyByteArrayToAddr#,copyAddrToByteArray#)
#endif

import GHC.Ptr (Ptr(..))
import System.IO.Unsafe
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property)

import qualified Data.List as L
import qualified Data.Primitive as P

import Test.QuickCheck.Classes.Internal (Laws(..),isTrue#)

-- | Test that a 'Prim' instance obey the several laws.
primLaws :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
primLaws :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
primLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Prim"
  [ (String
"ByteArray Put-Get (you get back what you put in)", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutGetByteArray Proxy a
p)
  , (String
"ByteArray Get-Put (putting back what you got out has no effect)", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primGetPutByteArray Proxy a
p)
  , (String
"ByteArray Put-Put (putting twice is same as putting once)", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutPutByteArray Proxy a
p)
  , (String
"ByteArray Set Range", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primSetByteArray Proxy a
p)
#if MIN_VERSION_base(4,7,0)
  , (String
"ByteArray List Conversion Roundtrips", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primListByteArray Proxy a
p)
#endif
  , (String
"Addr Put-Get (you get back what you put in)", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutGetAddr Proxy a
p)
  , (String
"Addr Get-Put (putting back what you got out has no effect)", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primGetPutAddr Proxy a
p)
  , (String
"Addr Set Range", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primSetOffAddr Proxy a
p)
  , (String
"Addr List Conversion Roundtrips", Proxy a -> Property
forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primListAddr Proxy a
p)
  ]

primListAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primListAddr :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primListAddr Proxy a
_ = ([a] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> Bool) -> Property) -> ([a] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) -> IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  ptr@(Ptr addr#) :: Ptr a <- Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Prim a => a -> Int
P.sizeOf (a
forall a. HasCallStack => a
undefined :: a))
  let addr = Addr# -> Addr
Addr Addr#
addr#
  let go :: Int -> [a] -> IO ()
      go !Int
ix [a]
xs = case [a]
xs of
        [] -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (a
x : [a]
xsNext) -> do
          Addr -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
writeOffAddr Addr
addr Int
ix a
x
          Int -> [a] -> IO ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xsNext
  go 0 as
  let rebuild :: Int -> IO [a]
      rebuild !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
        then (:) (a -> [a] -> [a]) -> IO a -> IO ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> Int -> IO a
forall a (m :: * -> *). (Prim a, PrimMonad m) => Addr -> Int -> m a
readOffAddr Addr
addr Int
ix IO ([a] -> [a]) -> IO [a] -> IO [a]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO [a]
rebuild (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  asNew <- rebuild 0
  free ptr
  return (as == asNew)

primPutGetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutGetByteArray :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutGetByteArray Proxy a
_ = (a -> Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Int -> Property) -> Property)
-> (a -> Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) Int
len -> (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Bool -> Gen Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> do
  ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  return $ runST $ do
    arr <- newPrimArray len
    writePrimArray arr ix a
    a' <- readPrimArray arr ix
    return (a == a')

primGetPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primGetPutByteArray :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primGetPutByteArray Proxy a
_ = ([a] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> Property) -> Property) -> ([a] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) -> (Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [a]
as)) Bool -> Gen Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> do
  let arr1 :: PrimArray a
arr1 = [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
as :: PrimArray a
      len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  arr2 <- return $ runST $ do
    marr <- newPrimArray len
    copyPrimArray marr 0 arr1 0 len
    a <- readPrimArray marr ix
    writePrimArray marr ix a
    unsafeFreezePrimArray marr
  return (arr1 == arr2)

primPutPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutPutByteArray :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutPutByteArray Proxy a
_ = (a -> [a] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> [a] -> Property) -> Property)
-> (a -> [a] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ([a]
as :: [a]) -> (Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [a]
as)) Bool -> Gen Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> do
  let arr1 :: PrimArray a
arr1 = [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
as :: PrimArray a
      len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  (arr2,arr3) <- return $ runST $ do
    marr2 <- newPrimArray len
    copyPrimArray marr2 0 arr1 0 len
    writePrimArray marr2 ix a
    marr3 <- newPrimArray len
    copyMutablePrimArray marr3 0 marr2 0 len
    arr2 <- unsafeFreezePrimArray marr2
    writePrimArray marr3 ix a
    arr3 <- unsafeFreezePrimArray marr3
    return (arr2,arr3)
  return (arr2 == arr3)

primPutGetAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutGetAddr :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primPutGetAddr Proxy a
_ = (a -> Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Int -> Property) -> Property)
-> (a -> Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) Int
len -> (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Bool -> Gen Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> do
  ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  return $ unsafePerformIO $ do
    ptr@(Ptr addr#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))
    let addr = Addr# -> Addr
Addr Addr#
addr#
    writeOffAddr addr ix a
    a' <- readOffAddr addr ix
    free ptr
    return (a == a')

primGetPutAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primGetPutAddr :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primGetPutAddr Proxy a
_ = ([a] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> Property) -> Property) -> ([a] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) -> (Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [a]
as)) Bool -> Gen Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> do
  let arr1 :: PrimArray a
arr1 = [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
as :: PrimArray a
      len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  ix <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  arr2 <- return $ unsafePerformIO $ do
    ptr@(Ptr addr#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))
    let addr = Addr# -> Addr
Addr Addr#
addr#
    copyPrimArrayToPtr ptr arr1 0 len
    a :: a <- readOffAddr addr ix
    writeOffAddr addr ix a
    marr <- newPrimArray len
    copyPtrToMutablePrimArray marr 0 ptr len
    free ptr
    unsafeFreezePrimArray marr
  return (arr1 == arr2)

primSetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primSetByteArray :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primSetByteArray Proxy a
_ = ([a] -> a -> Gen Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> a -> Gen Bool) -> Property)
-> ([a] -> a -> Gen Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) (a
z :: a) -> do
  let arr1 :: PrimArray a
arr1 = [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
as :: PrimArray a
      len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  x <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  y <- choose (0,len)
  let lo = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y
      hi = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y
  return $ runST $ do
    marr2 <- newPrimArray len
    copyPrimArray marr2 0 arr1 0 len
    marr3 <- newPrimArray len
    copyPrimArray marr3 0 arr1 0 len
    setPrimArray marr2 lo (hi - lo) z
    internalDefaultSetPrimArray marr3 lo (hi - lo) z
    arr2 <- unsafeFreezePrimArray marr2
    arr3 <- unsafeFreezePrimArray marr3
    return (arr2 == arr3)

primSetOffAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primSetOffAddr :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primSetOffAddr Proxy a
_ = ([a] -> a -> Gen Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> a -> Gen Bool) -> Property)
-> ([a] -> a -> Gen Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) (a
z :: a) -> do
  let arr1 :: PrimArray a
arr1 = [a] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
as :: PrimArray a
      len :: Int
len = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  x <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  y <- choose (0,len)
  let lo = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y
      hi = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y
  return $ unsafePerformIO $ do
    ptrA@(Ptr addrA#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))
    let addrA = Addr# -> Addr
Addr Addr#
addrA#
    copyPrimArrayToPtr ptrA arr1 0 len
    ptrB@(Ptr addrB#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))
    let addrB = Addr# -> Addr
Addr Addr#
addrB#
    copyPrimArrayToPtr ptrB arr1 0 len
    setOffAddr addrA lo (hi - lo) z
    internalDefaultSetOffAddr addrB lo (hi - lo) z
    marrA <- newPrimArray len
    copyPtrToMutablePrimArray marrA 0 ptrA len
    free ptrA
    marrB <- newPrimArray len
    copyPtrToMutablePrimArray marrB 0 ptrB len
    free ptrB
    arrA <- unsafeFreezePrimArray marrA
    arrB <- unsafeFreezePrimArray marrB
    return (arrA == arrB)

-- byte array with phantom variable that specifies element type
data PrimArray a = PrimArray ByteArray#
data MutablePrimArray s a = MutablePrimArray (MutableByteArray# s)

instance (Eq a, Prim a) => Eq (PrimArray a) where
  PrimArray a
a1 == :: PrimArray a -> PrimArray a -> Bool
== PrimArray a
a2 = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
a1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    where
    loop :: Int -> Bool
loop !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
True
            | Bool
otherwise = PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
a1 Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
a2 Int
i Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

#if MIN_VERSION_base(4,7,0)
instance Prim a => IsList (PrimArray a) where
  type Item (PrimArray a) = a
  fromList :: [Item (PrimArray a)] -> PrimArray a
fromList = [a] -> PrimArray a
[Item (PrimArray a)] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList
  fromListN :: Int -> [Item (PrimArray a)] -> PrimArray a
fromListN = Int -> [a] -> PrimArray a
Int -> [Item (PrimArray a)] -> PrimArray a
forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN
  toList :: PrimArray a -> [Item (PrimArray a)]
toList = PrimArray a -> [a]
PrimArray a -> [Item (PrimArray a)]
forall a. Prim a => PrimArray a -> [a]
primArrayToList
#endif

indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray (PrimArray ByteArray#
arr#) (I# Int#
i#) = ByteArray# -> Int# -> a
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
arr# Int#
i#

sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int
sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int
sizeofPrimArray (PrimArray ByteArray#
arr#) = Int# -> Int
I# (Int# -> Int# -> Int#
quotInt# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#) (a -> Int#
forall a. Prim a => a -> Int#
P.sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))

newPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (I# Int#
n#)
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutablePrimArray (PrimState m) a #))
-> m (MutablePrimArray (PrimState m) a)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# ->
      case Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
n# Int# -> Int# -> Int#
*# a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)) State# (PrimState m)
s# of
        (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m)
arr# #) -> (# State# (PrimState m)
s'#, MutableByteArray# (PrimState m) -> MutablePrimArray (PrimState m) a
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MutableByteArray# (PrimState m)
arr# #)
    )

readPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray (MutablePrimArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#)
  = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (MutableByteArray# (PrimState m)
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# (PrimState m)
arr# Int#
i#)

writePrimArray ::
     (Prim a, PrimMonad m)
  => MutablePrimArray (PrimState m) a
  -> Int
  -> a
  -> m ()
writePrimArray :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray (MutablePrimArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
x
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# (PrimState m)
arr# Int#
i# a
x)

unsafeFreezePrimArray
  :: PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray (MutablePrimArray MutableByteArray# (PrimState m)
arr#)
  = (State# (PrimState m) -> (# State# (PrimState m), PrimArray a #))
-> m (PrimArray a)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case MutableByteArray# (PrimState m)
-> State# (PrimState m) -> (# State# (PrimState m), ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# (PrimState m)
arr# State# (PrimState m)
s# of
                        (# State# (PrimState m)
s'#, ByteArray#
arr'# #) -> (# State# (PrimState m)
s'#, ByteArray# -> PrimArray a
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
arr'# #))

#if !MIN_VERSION_base(4,7,0)
ptrToAddr :: Ptr a -> Addr
ptrToAddr (Ptr x) = Addr x

generateM_ :: Monad m => Int -> (Int -> m a) -> m ()
generateM_ n f = go 0 where
  go !ix = if ix < n
    then f ix >> go (ix + 1)
    else return ()
#endif

copyPrimArrayToPtr :: forall m a. (PrimMonad m, Prim a)
  => Ptr a       -- ^ destination pointer
  -> PrimArray a -- ^ source array
  -> Int         -- ^ offset into source array
  -> Int         -- ^ number of prims to copy
  -> m ()
#if MIN_VERSION_base(4,7,0)
copyPrimArrayToPtr :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr (Ptr Addr#
addr#) (PrimArray ByteArray#
ba#) (I# Int#
soff#) (I# Int#
n#) =
  (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\ State# (PrimState m)
s# ->
      let s'# :: State# (PrimState m)
s'# = ByteArray#
-> Int#
-> Addr#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# (Int#
soff# Int# -> Int# -> Int#
*# Int#
siz#) Addr#
addr# (Int#
n# Int# -> Int# -> Int#
*# Int#
siz#) State# (PrimState m)
s#
      in (# State# (PrimState m)
s'#, () #))
  where siz# :: Int#
siz# = a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)
#else
copyPrimArrayToPtr addr ba soff n =
  generateM_ n $ \ix -> writeOffAddr (ptrToAddr addr) ix (indexPrimArray ba (ix + soff))
#endif

copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)
  => MutablePrimArray (PrimState m) a
  -> Int
  -> Ptr a
  -> Int
  -> m ()
#if MIN_VERSION_base(4,7,0)
copyPtrToMutablePrimArray :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray (MutablePrimArray MutableByteArray# (PrimState m)
ba#) (I# Int#
doff#) (Ptr Addr#
addr#) (I# Int#
n#) =
  (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\ State# (PrimState m)
s# ->
      let s'# :: State# (PrimState m)
s'# = Addr#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr# MutableByteArray# (PrimState m)
ba# (Int#
doff# Int# -> Int# -> Int#
*# Int#
siz#) (Int#
n# Int# -> Int# -> Int#
*# Int#
siz#) State# (PrimState m)
s#
      in (# State# (PrimState m)
s'#, () #))
  where siz# :: Int#
siz# = a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)
#else
copyPtrToMutablePrimArray ba doff addr n =
  generateM_ n $ \ix -> do
    x <- readOffAddr (ptrToAddr addr) ix
    writePrimArray ba (doff + ix) x
#endif

copyMutablePrimArray :: forall m a.
     (PrimMonad m, Prim a)
  => MutablePrimArray (PrimState m) a -- ^ destination array
  -> Int -- ^ offset into destination array
  -> MutablePrimArray (PrimState m) a -- ^ source array
  -> Int -- ^ offset into source array
  -> Int -- ^ number of bytes to copy
  -> m ()
copyMutablePrimArray :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray (MutablePrimArray MutableByteArray# (PrimState m)
dst#) (I# Int#
doff#) (MutablePrimArray MutableByteArray# (PrimState m)
src#) (I# Int#
soff#) (I# Int#
n#)
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray#
      MutableByteArray# (PrimState m)
src#
      (Int#
soff# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
      MutableByteArray# (PrimState m)
dst#
      (Int#
doff# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
      (Int#
n# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
    )

copyPrimArray :: forall m a.
     (PrimMonad m, Prim a)
  => MutablePrimArray (PrimState m) a -- ^ destination array
  -> Int -- ^ offset into destination array
  -> PrimArray a -- ^ source array
  -> Int -- ^ offset into source array
  -> Int -- ^ number of bytes to copy
  -> m ()
copyPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray (MutablePrimArray MutableByteArray# (PrimState m)
dst#) (I# Int#
doff#) (PrimArray ByteArray#
src#) (I# Int#
soff#) (I# Int#
n#)
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (ByteArray#
-> Int#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray#
      ByteArray#
src#
      (Int#
soff# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
      MutableByteArray# (PrimState m)
dst#
      (Int#
doff# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
      (Int#
n# Int# -> Int# -> Int#
*# (a -> Int#
forall a. Prim a => a -> Int#
sizeOf# (a
forall a. HasCallStack => a
undefined :: a)))
    )

setPrimArray
  :: (Prim a, PrimMonad m)
  => MutablePrimArray (PrimState m) a -- ^ array to fill
  -> Int -- ^ offset into array
  -> Int -- ^ number of values to fill
  -> a -- ^ value to fill with
  -> m ()
setPrimArray :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray (MutablePrimArray MutableByteArray# (PrimState m)
dst#) (I# Int#
doff#) (I# Int#
sz#) a
x
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> a
-> State# (PrimState m)
-> State# (PrimState m)
forall s.
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
P.setByteArray# MutableByteArray# (PrimState m)
dst# Int#
doff# Int#
sz# a
x)

primArrayFromList :: Prim a => [a] -> PrimArray a
primArrayFromList :: forall a. Prim a => [a] -> PrimArray a
primArrayFromList [a]
xs = Int -> [a] -> PrimArray a
forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
xs) [a]
xs

primArrayFromListN :: forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN :: forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN Int
len [a]
vs = (forall s. ST s (PrimArray a)) -> PrimArray a
forall a. (forall s. ST s a) -> a
runST ST s (PrimArray a)
forall s. ST s (PrimArray a)
run where
  run :: forall s. ST s (PrimArray a)
  run :: forall s. ST s (PrimArray a)
run = do
    arr <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    let go :: [a] -> Int -> ST s ()
        go ![a]
xs !Int
ix = case [a]
xs of
          [] -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          a
a : [a]
as -> do
            MutablePrimArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
arr Int
ix a
a
            [a] -> Int -> ST s ()
go [a]
as (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    go vs 0
    unsafeFreezePrimArray arr

primArrayToList :: forall a. Prim a => PrimArray a -> [a]
primArrayToList :: forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray a
arr = Int -> [a]
go Int
0 where
  !len :: Int
len = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
arr
  go :: Int -> [a]
  go :: Int -> [a]
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
    then PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
arr Int
ix a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    else []

#if MIN_VERSION_base(4,7,0)
primListByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primListByteArray :: forall a.
(Prim a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
primListByteArray Proxy a
_ = ([a] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> Bool) -> Property) -> ([a] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) ->
  [a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a -> [Item (PrimArray a)]
forall l. IsList l => l -> [Item l]
toList ([Item (PrimArray a)] -> PrimArray a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (PrimArray a)]
as :: PrimArray a)
#endif

setOffAddr :: forall a. Prim a => Addr -> Int -> Int -> a -> IO ()
setOffAddr :: forall a. Prim a => Addr -> Int -> Int -> a -> IO ()
setOffAddr Addr
addr Int
ix Int
len a
a = Addr -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
setAddr (Addr -> Int -> Addr
plusAddr Addr
addr (a -> Int
forall a. Prim a => a -> Int
P.sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ix)) Int
len a
a

internalDefaultSetPrimArray :: Prim a
  => MutablePrimArray s a -> Int -> Int -> a -> ST s ()
internalDefaultSetPrimArray :: forall a s.
Prim a =>
MutablePrimArray s a -> Int -> Int -> a -> ST s ()
internalDefaultSetPrimArray (MutablePrimArray MutableByteArray# s
arr) (I# Int#
i) (I# Int#
len) a
ident =
  (State# (PrimState (ST s)) -> State# (PrimState (ST s))) -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetByteArray# MutableByteArray# s
arr Int#
i Int#
len a
ident)

internalDefaultSetByteArray# :: Prim a
  => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetByteArray# :: forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetByteArray# MutableByteArray# s
arr# Int#
i# Int#
len# a
ident = Int# -> State# s -> State# s
go Int#
0#
  where
  go :: Int# -> State# s -> State# s
go Int#
ix# State# s
s0 = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
<# Int#
len#)
    then case MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr# (Int#
i# Int# -> Int# -> Int#
+# Int#
ix#) a
ident State# s
s0 of
      State# s
s1 -> Int# -> State# s -> State# s
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# s
s1
    else State# s
s0

internalDefaultSetOffAddr :: Prim a => Addr -> Int -> Int -> a -> IO ()
internalDefaultSetOffAddr :: forall a. Prim a => Addr -> Int -> Int -> a -> IO ()
internalDefaultSetOffAddr (Addr Addr#
addr) (I# Int#
ix) (I# Int#
len) a
a = (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_
  (Addr# -> Int# -> Int# -> a -> State# RealWorld -> State# RealWorld
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetOffAddr# Addr#
addr Int#
ix Int#
len a
a)

internalDefaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
internalDefaultSetOffAddr# Addr#
addr# Int#
i# Int#
len# a
ident = Int# -> State# s -> State# s
go Int#
0#
  where
  go :: Int# -> State# s -> State# s
go Int#
ix# State# s
s0 = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
<# Int#
len#)
    then case Addr# -> Int# -> a -> State# s -> State# s
forall s. Addr# -> Int# -> a -> State# s -> State# s
forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# (Int#
i# Int# -> Int# -> Int#
+# Int#
ix#) a
ident State# s
s0 of
      State# s
s1 -> Int# -> State# s -> State# s
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# s
s1
    else State# s
s0