{-# 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 :: 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 :: 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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  ptr :: Ptr a
ptr@(Ptr Addr#
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 Addr#
addr#
  let go :: Int -> [a] -> IO ()
      go :: Int -> [a] -> IO ()
go !Int
ix [a]
xs = case [a]
xs of
        [] -> () -> IO ()
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
  Int -> [a] -> IO ()
go Int
0 [a]
as
  let rebuild :: Int -> IO [a]
      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 (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 (m :: * -> *) a. Monad m => a -> m a
return []
  [a]
asNew <- Int -> IO [a]
rebuild Int
0
  Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
ptr
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
asNew)

primPutGetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutGetByteArray :: 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
  Int
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)
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Bool) -> Bool) -> (forall s. ST s Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
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
    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
a' <- MutablePrimArray (PrimState (ST s)) a -> Int -> ST s a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
arr Int
ix
    Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a')

primGetPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primGetPutByteArray :: 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  Int
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)
  PrimArray a
arr2 <- PrimArray a -> Gen (PrimArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a -> Gen (PrimArray a))
-> PrimArray a -> Gen (PrimArray a)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (PrimArray a)) -> PrimArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (PrimArray a)) -> PrimArray a)
-> (forall s. ST s (PrimArray a)) -> PrimArray a
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
marr <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState (ST s)) a
-> Int -> PrimArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr Int
0 PrimArray a
arr1 Int
0 Int
len
    a
a <- MutablePrimArray (PrimState (ST s)) a -> Int -> ST s a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr Int
ix
    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
marr Int
ix a
a
    MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arr1 PrimArray a -> PrimArray a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a
arr2)

primPutPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutPutByteArray :: 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  Int
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)
  (PrimArray a
arr2,PrimArray a
arr3) <- (PrimArray a, PrimArray a) -> Gen (PrimArray a, PrimArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((PrimArray a, PrimArray a) -> Gen (PrimArray a, PrimArray a))
-> (PrimArray a, PrimArray a) -> Gen (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (PrimArray a, PrimArray a))
-> (PrimArray a, PrimArray a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (PrimArray a, PrimArray a))
 -> (PrimArray a, PrimArray a))
-> (forall s. ST s (PrimArray a, PrimArray a))
-> (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
marr2 <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState (ST s)) a
-> Int -> PrimArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
    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
marr2 Int
ix a
a
    MutablePrimArray s a
marr3 <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState (ST s)) a
-> Int
-> MutablePrimArray (PrimState (ST s)) a
-> Int
-> Int
-> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr3 Int
0 MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2 Int
0 Int
len
    PrimArray a
arr2 <- MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2
    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
marr3 Int
ix a
a
    PrimArray a
arr3 <- MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr3
    (PrimArray a, PrimArray a) -> ST s (PrimArray a, PrimArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arr2,PrimArray a
arr3)
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arr2 PrimArray a -> PrimArray a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a
arr3)

primPutGetAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primPutGetAddr :: 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
  Int
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)
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    ptr :: Ptr a
ptr@(Ptr Addr#
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 Addr#
addr#
    Addr -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
writeOffAddr Addr
addr Int
ix a
a
    a
a' <- Addr -> Int -> IO a
forall a (m :: * -> *). (Prim a, PrimMonad m) => Addr -> Int -> m a
readOffAddr Addr
addr Int
ix
    Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
ptr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a')

primGetPutAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primGetPutAddr :: 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  Int
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)
  PrimArray a
arr2 <- PrimArray a -> Gen (PrimArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a -> Gen (PrimArray a))
-> PrimArray a -> Gen (PrimArray a)
forall a b. (a -> b) -> a -> b
$ IO (PrimArray a) -> PrimArray a
forall a. IO a -> a
unsafePerformIO (IO (PrimArray a) -> PrimArray a)
-> IO (PrimArray a) -> PrimArray a
forall a b. (a -> b) -> a -> b
$ do
    ptr :: Ptr a
ptr@(Ptr Addr#
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 Addr#
addr#
    Ptr a -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
ptr PrimArray a
arr1 Int
0 Int
len
    a
a :: a <- Addr -> Int -> IO a
forall a (m :: * -> *). (Prim a, PrimMonad m) => Addr -> Int -> m a
readOffAddr Addr
addr Int
ix
    Addr -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
writeOffAddr Addr
addr Int
ix a
a
    MutablePrimArray RealWorld a
marr <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) a -> Int -> Ptr a -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr Int
0 Ptr a
ptr Int
len
    Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
ptr
    MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arr1 PrimArray a -> PrimArray a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a
arr2)

primSetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primSetByteArray :: 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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  Int
x <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  Int
y <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  let lo :: Int
lo = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y
      hi :: Int
hi = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Bool) -> Bool) -> (forall s. ST s Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
marr2 <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState (ST s)) a
-> Int -> PrimArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
    MutablePrimArray s a
marr3 <- Int -> ST s (MutablePrimArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState (ST s)) a
-> Int -> PrimArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr3 Int
0 PrimArray a
arr1 Int
0 Int
len
    MutablePrimArray (PrimState (ST s)) a -> Int -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2 Int
lo (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo) a
z
    MutablePrimArray s a -> Int -> Int -> a -> ST s ()
forall a s.
Prim a =>
MutablePrimArray s a -> Int -> Int -> a -> ST s ()
internalDefaultSetPrimArray MutablePrimArray s a
marr3 Int
lo (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo) a
z
    PrimArray a
arr2 <- MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr2
    PrimArray a
arr3 <- MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
marr3
    Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arr2 PrimArray a -> PrimArray a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a
arr3)

primSetOffAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
primSetOffAddr :: 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 (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
as
  Int
x <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  Int
y <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
len)
  let lo :: Int
lo = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y
      hi :: Int
hi = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y
  Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    ptrA :: Ptr a
ptrA@(Ptr Addr#
addrA#) :: 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 addrA :: Addr
addrA = Addr# -> Addr
Addr Addr#
addrA#
    Ptr a -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
ptrA PrimArray a
arr1 Int
0 Int
len
    ptrB :: Ptr a
ptrB@(Ptr Addr#
addrB#) :: 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 addrB :: Addr
addrB = Addr# -> Addr
Addr Addr#
addrB#
    Ptr a -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
ptrB PrimArray a
arr1 Int
0 Int
len
    Addr -> Int -> Int -> a -> IO ()
forall a. Prim a => Addr -> Int -> Int -> a -> IO ()
setOffAddr Addr
addrA Int
lo (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo) a
z
    Addr -> Int -> Int -> a -> IO ()
forall a. Prim a => Addr -> Int -> Int -> a -> IO ()
internalDefaultSetOffAddr Addr
addrB Int
lo (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo) a
z
    MutablePrimArray RealWorld a
marrA <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) a -> Int -> Ptr a -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marrA Int
0 Ptr a
ptrA Int
len
    Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
ptrA
    MutablePrimArray RealWorld a
marrB <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
    MutablePrimArray (PrimState IO) a -> Int -> Ptr a -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marrB Int
0 Ptr a
ptrB Int
len
    Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
ptrB
    PrimArray a
arrA <- MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marrA
    PrimArray a
arrB <- MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marrB
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray a
arrA PrimArray a -> PrimArray a -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray a
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 = [Item (PrimArray a)] -> PrimArray a
forall a. Prim a => [a] -> PrimArray a
primArrayFromList
  fromListN :: Int -> [Item (PrimArray a)] -> PrimArray a
fromListN = Int -> [Item (PrimArray a)] -> PrimArray a
forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN
  toList :: PrimArray a -> [Item (PrimArray a)]
toList = PrimArray a -> [Item (PrimArray a)]
forall a. Prim a => PrimArray a -> [a]
primArrayToList
#endif

indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray :: 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 :: 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 :: 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 (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 :: 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 (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 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 :: 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 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 :: 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 (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 :: 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 (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 :: 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 (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 :: 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 :: 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 :: 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 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 :: [a] -> PrimArray a
primArrayFromList [a]
xs = Int -> [a] -> PrimArray a
forall a. Prim a => Int -> [a] -> PrimArray a
primArrayFromListN ([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 :: 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 forall s. ST s (PrimArray a)
run where
  run :: forall s. ST s (PrimArray a)
  run :: ST s (PrimArray a)
run = do
    MutablePrimArray s a
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] -> Int -> ST s ()
go ![a]
xs !Int
ix = case [a]
xs of
          [] -> () -> ST s ()
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)
    [a] -> Int -> ST s ()
go [a]
vs Int
0
    MutablePrimArray (PrimState (ST s)) a -> ST s (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState (ST s)) a
arr

primArrayToList :: forall a. Prim a => PrimArray a -> [a]
primArrayToList :: 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 :: 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 :: 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 :: 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# :: 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 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 :: 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# :: 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 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