{-# language CPP #-}
{-# language LambdaCase #-}
{-# language UnboxedTuples #-}
{-# language TypeApplications #-}
{-# language MagicHash #-}
{-# language BangPatterns #-}
{-# language ScopedTypeVariables #-}
#ifndef HAVE_PRIMITIVE
module Hedgehog.Classes.Prim () where
#else
module Hedgehog.Classes.Prim (primLaws) where
import Control.Monad (when)
import Foreign.Marshal.Alloc
import GHC.Exts hiding (setByteArray#)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Primitive
import Data.Primitive
import Data.Primitive.Ptr
import Hedgehog
import Hedgehog.Classes.Common
import Hedgehog.Internal.Gen (sample)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
primLaws :: (Prim a, Eq a, Show a) => Gen a -> Laws
primLaws :: forall a. (Prim a, Eq a, Show a) => Gen a -> Laws
primLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Prim"
[ (String
"ByteArray Set-Get (you get back what you put in)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetByteArray Gen a
gen)
, (String
"ByteArray Get-Set (putting back what you got out has no effect)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetByteArray Gen a
gen)
, (String
"ByteArray Set-Set (putting twice is the same as putting once)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetByteArray Gen a
gen)
, (String
"ByteArray Set Range", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetByteArray Gen a
gen)
, (String
"ByteArray List Conversion Roundtrips", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripByteArray Gen a
gen)
, (String
"Addr Set-Get (you get back what you put in)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetAddr Gen a
gen)
, (String
"Addr Get-Set (putting back what you got out has no effect)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetAddr Gen a
gen)
, (String
"Addr Set-Set (putting twice is the same as putting once)", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetAddr Gen a
gen)
, (String
"Addr Set Range", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetRangeAddr Gen a
gen)
, (String
"Addr List Conversion Roundtrips", forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripAddr Gen a
gen)
]
genSmallArrayLen :: Gen Int
genSmallArrayLen :: Gen Int
genSmallArrayLen = forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
10)
genMutPrimArray :: Prim a => Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray :: forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len = do
MutablePrimArray RealWorld a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
let go :: Int -> IO ()
go :: Int -> IO ()
go !Int
ix = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix forall a. Ord a => a -> a -> Bool
< Int
len) forall a b. (a -> b) -> a -> b
$ do
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
marr Int
ix forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => Gen a -> m a
sample Gen a
gen
Int -> IO ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
Int -> IO ()
go Int
0
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutablePrimArray RealWorld a
marr
genPrimArray :: forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray :: forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len = forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len
primSetGetByteArray :: (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
el' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray RealWorld a
marr <- forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
marr Int
ix a
el
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
marr Int
ix
a
el forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
el'
primGetSetByteArray :: (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
(PrimArray a
arr1, PrimArray a
arr2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
MutablePrimArray RealWorld a
marr2 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
marr2 Int
ix forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
marr2 Int
ix
PrimArray a
arr2 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr2
primSetSetByteArray :: (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr1, PrimArray a
arr2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray RealWorld a
marr1 <- forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
marr1 Int
ix a
el
MutablePrimArray RealWorld a
marr2 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld a
marr2 Int
0 MutablePrimArray RealWorld a
marr1 Int
0 Int
len
PrimArray a
arr1 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr1
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
marr2 Int
ix a
el
PrimArray a
arr2 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr2
primSetByteArray :: (Eq a, Show a, Prim a) => Gen a -> Property
primSetByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
(Int
low, Int
high) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Ord b => (b, b) -> (b, b)
order forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1)))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
MutablePrimArray RealWorld a
marr2 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
MutablePrimArray RealWorld a
marr3 <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
marr3 Int
0 PrimArray a
arr1 Int
0 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld a
marr2 Int
low (Int
high forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr2 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr2
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
defaultSetPrimArray MutablePrimArray RealWorld a
marr3 Int
low (Int
high forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr3 <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr3
where
order :: (b, b) -> (b, b)
order (b
x, b
y) = if b
x forall a. Ord a => a -> a -> Bool
< b
y then (b
x, b
y) else (b
y, b
x)
defaultSetPrimArray :: (Prim a, PrimMonad m)
=> MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
defaultSetPrimArray :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
defaultSetPrimArray (MutablePrimArray MutableByteArray# (PrimState m)
marr#) (I# Int#
off#) (I# Int#
len#) a
x = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Int# -> State# (PrimState m) -> State# (PrimState m)
go Int#
off#)
where
end# :: Int#
end# = Int#
off# Int# -> Int# -> Int#
+# Int#
len#
go :: Int# -> State# (PrimState m) -> State# (PrimState m)
go !Int#
ix# State# (PrimState m)
s# = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
>=# Int#
end#)
then State# (PrimState m)
s#
else case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# (PrimState m)
marr# Int#
ix# a
x State# (PrimState m)
s# of
State# (PrimState m)
s2# -> Int# -> State# (PrimState m) -> State# (PrimState m)
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# (PrimState m)
s2#
primListRoundtripByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripByteArray :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallNonEmptyList Gen a
gen
[a]
xs forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall l. IsList l => l -> [Item l]
toList (forall l. IsList l => [Item l] -> l
fromList [a]
xs :: PrimArray a)
withBytes :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len Ptr a -> IO b
h = do
Ptr a
p <- forall a. Int -> IO (Ptr a)
mallocBytes (Int
len forall a. Num a => a -> a -> a
* forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
Ptr a -> IO b
h Ptr a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Ptr a -> IO ()
free Ptr a
p
ptrToPrimArray :: forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray :: forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p Int
len = do
MutablePrimArray RealWorld a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
marr Int
0 Ptr a
p Int
len
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
marr
primSetGetAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
el' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix a
el
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p Int
ix
a
el forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
el'
primGetSetAddr :: (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primGetSetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
(PrimArray a
arr1, PrimArray a
arr2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
PrimArray a
arr2 <- forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p PrimArray a
arr1 Int
0 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p Int
ix
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p Int
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr2
primSetSetAddr :: (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p1 -> do
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p1 PrimArray a
arr1 Int
0 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p1 Int
ix a
el
PrimArray a
arr2 <- forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p1 Int
len
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p2 -> do
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p2 PrimArray a
arr2 Int
0 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p2 Int
ix a
el
PrimArray a
arr3 <- forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p2 Int
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr3
primSetRangeAddr :: (Eq a, Show a, Prim a) => Gen a -> Property
primSetRangeAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetRangeAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
Int
len <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
(Int
low, Int
high) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Ord b => (b, b) -> (b, b)
order forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len forall a. Num a => a -> a -> a
- Int
1)))
a
el <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p1 -> do
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p2 -> do
PrimArray a
arr1 <- forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p1 PrimArray a
arr1 Int
0 Int
len
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p2 PrimArray a
arr1 Int
0 Int
len
forall {m :: * -> *} {a} {a}.
(PrimMonad m, Prim a) =>
Ptr a -> Int -> Int -> a -> m ()
setOffPtr Ptr a
p1 Int
low (Int
high forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr2 <- forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p1 Int
len
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> Int -> a -> m ()
defaultSetOffAddr Ptr a
p2 Int
low (Int
high forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr3 <- forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p2 Int
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== PrimArray a
arr3
where
order :: (b, b) -> (b, b)
order (b
x, b
y) = if b
x forall a. Ord a => a -> a -> Bool
< b
y then (b
x, b
y) else (b
y, b
x)
setOffPtr :: Ptr a -> Int -> Int -> a -> m ()
setOffPtr (Ptr Addr#
addr#) (I# Int#
off#) (I# Int#
len#) a
x =
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
setOffAddr# Addr#
addr# Int#
off# Int#
len# a
x)
defaultSetOffAddr :: (Prim a, PrimMonad m) => Ptr a -> Int -> Int -> a -> m ()
defaultSetOffAddr :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> Int -> a -> m ()
defaultSetOffAddr (Ptr Addr#
addr#) (I# Int#
off#) (I# Int#
len#) a
x = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall {s}. Int# -> State# s -> State# s
go Int#
off#)
where
end# :: Int#
end# = Int#
off# Int# -> Int# -> Int#
+# Int#
len#
go :: Int# -> State# s -> State# s
go !Int#
ix# State# s
s# = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
>=# Int#
end#)
then State# s
s#
else case forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# Int#
ix# a
x State# s
s# of
State# s
s2# -> Int# -> State# s -> State# s
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# s
s2#
primListRoundtripAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
[a]
xs' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
let listToPtr :: Int -> [a] -> IO ()
listToPtr :: Int -> [a] -> IO ()
listToPtr !Int
ix = \case
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(a
y:[a]
ys) -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix a
y forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> [a] -> IO ()
listToPtr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) [a]
ys
let ptrToList :: Int -> IO [a]
ptrToList :: Int -> IO [a]
ptrToList !Int
ix =
if Int
ix forall a. Ord a => a -> a -> Bool
>= Int
len
then forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p Int
ix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO [a]
ptrToList (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
Int -> [a] -> IO ()
listToPtr Int
0 [a]
xs
Int -> IO [a]
ptrToList Int
0
[a]
xs forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== [a]
xs'
#endif