{-# language LambdaCase #-}
{-# language UnboxedTuples #-}
{-# language TypeApplications #-}
{-# language MagicHash #-}
{-# language BangPatterns #-}
{-# language ScopedTypeVariables #-}
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 :: 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)", Gen a -> Property
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)", Gen a -> Property
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)", Gen a -> Property
forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetByteArray Gen a
gen)
, (String
"ByteArray Set Range", Gen a -> Property
forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetByteArray Gen a
gen)
, (String
"ByteArray List Conversion Roundtrips", Gen a -> Property
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)", Gen a -> Property
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)", Gen a -> Property
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)", Gen a -> Property
forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetSetAddr Gen a
gen)
, (String
"Addr Set Range", Gen a -> Property
forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetRangeAddr Gen a
gen)
, (String
"Addr List Conversion Roundtrips", Gen a -> Property
forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primListRoundtripAddr Gen a
gen)
]
genSmallArrayLen :: Gen Int
genSmallArrayLen :: Gen Int
genSmallArrayLen = Range Int -> Gen Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
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 :: Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len = do
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
let go :: Int -> IO ()
go :: Int -> IO ()
go !Int
ix = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr Int
ix (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen a -> IO a
forall (m :: * -> *) a. MonadIO m => Gen a -> m a
sample Gen a
gen
Int -> IO ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Int -> IO ()
go Int
0
MutablePrimArray RealWorld a -> IO (MutablePrimArray RealWorld a)
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 :: Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len = MutablePrimArray RealWorld a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray (MutablePrimArray RealWorld a -> IO (PrimArray a))
-> IO (MutablePrimArray RealWorld a) -> IO (PrimArray a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
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 :: Gen a -> Property
primSetGetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
el' <- IO a -> PropertyT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PropertyT IO a) -> IO a -> PropertyT IO a
forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray RealWorld a
marr <- Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr Int
ix a
el
MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr Int
ix
a
el a -> a -> PropertyT IO ()
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 :: Gen a -> Property
primGetSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
(PrimArray a
arr1, PrimArray a
arr2) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- Gen a -> Int -> IO (PrimArray a)
forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
MutablePrimArray RealWorld a
marr2 <- 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 -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
ix (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutablePrimArray (PrimState IO) a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
ix
PrimArray a
arr2 <- 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
marr2
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 PrimArray a -> PrimArray a -> PropertyT IO ()
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 :: Gen a -> Property
primSetSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr1, PrimArray a
arr2) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
MutablePrimArray RealWorld a
marr1 <- Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
forall a.
Prim a =>
Gen a -> Int -> IO (MutablePrimArray (PrimState IO) a)
genMutPrimArray Gen a
gen Int
len
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr1 Int
ix a
el
MutablePrimArray RealWorld a
marr2 <- 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 -> MutablePrimArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
0 MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr1 Int
0 Int
len
PrimArray a
arr1 <- 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
marr1
MutablePrimArray (PrimState IO) a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
ix a
el
PrimArray a
arr2 <- 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
marr2
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 PrimArray a -> PrimArray a -> PropertyT IO ()
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 :: Gen a -> Property
primSetByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
(Int
low, Int
high) <- ((Int, Int) -> (Int, Int))
-> PropertyT IO (Int, Int) -> PropertyT IO (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> (Int, Int)
forall b. Ord b => (b, b) -> (b, b)
order (PropertyT IO (Int, Int) -> PropertyT IO (Int, Int))
-> PropertyT IO (Int, Int) -> PropertyT IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ (,)
(Int -> Int -> (Int, Int))
-> PropertyT IO Int -> PropertyT IO (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
PropertyT IO (Int -> (Int, Int))
-> PropertyT IO Int -> PropertyT IO (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- Gen a -> Int -> IO (PrimArray a)
forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
MutablePrimArray RealWorld a
marr2 <- 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 -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
0 PrimArray a
arr1 Int
0 Int
len
MutablePrimArray RealWorld a
marr3 <- 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 -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr3 Int
0 PrimArray a
arr1 Int
0 Int
len
MutablePrimArray (PrimState IO) a -> Int -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr2 Int
low (Int
high Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr2 <- 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
marr2
MutablePrimArray (PrimState IO) a -> Int -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
defaultSetPrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
marr3 Int
low (Int
high Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr3 <- 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
marr3
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 PrimArray a -> PrimArray a -> PropertyT IO ()
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 b -> b -> Bool
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 :: MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
defaultSetPrimArray (MutablePrimArray MutableByteArray# (PrimState m)
marr#) (I# Int#
off#) (I# Int#
len#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
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 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)
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 :: Gen a -> Property
primListRoundtripByteArray Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- Gen [a] -> PropertyT IO [a]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
forall a b. (a -> b) -> a -> b
$ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genSmallNonEmptyList Gen a
gen
[a]
xs [a] -> [a] -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== 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)]
xs :: PrimArray a)
withBytes :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes :: Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len Ptr a -> IO b
h = do
Ptr a
p <- 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
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
Ptr a -> IO b
h Ptr a
p IO b -> IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
p
ptrToPrimArray :: forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray :: Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p Int
len = do
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
p Int
len
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
primSetGetAddr :: forall a. (Eq a, Show a, Prim a) => Gen a -> Property
primSetGetAddr :: Gen a -> Property
primSetGetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
el' <- IO a -> PropertyT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PropertyT IO a) -> IO a -> PropertyT IO a
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr a -> IO a) -> IO a
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix a
el
Ptr a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p Int
ix
a
el a -> a -> PropertyT IO ()
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 :: Gen a -> Property
primGetSetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
(PrimArray a
arr1, PrimArray a
arr2) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- Gen a -> Int -> IO (PrimArray a)
forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
PrimArray a
arr2 <- Int -> (Ptr a -> IO (PrimArray a)) -> IO (PrimArray a)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO (PrimArray a)) -> IO (PrimArray a))
-> (Ptr a -> IO (PrimArray a)) -> IO (PrimArray a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
Ptr a -> PrimArray a -> Int -> Int -> IO ()
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
Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p Int
ix
Ptr a -> Int -> IO (PrimArray a)
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p Int
len
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr1, PrimArray a
arr2)
PrimArray a
arr1 PrimArray a -> PrimArray a -> PropertyT IO ()
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 :: Gen a -> Property
primSetSetAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
Int
ix <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Int -> PropertyT IO Int) -> Gen Int -> PropertyT IO Int
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
PrimArray a
arr1 <- Gen a -> Int -> IO (PrimArray a)
forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
Int
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a))
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p1 -> do
Ptr a -> PrimArray a -> Int -> Int -> IO ()
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
Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p1 Int
ix a
el
PrimArray a
arr2 <- Ptr a -> Int -> IO (PrimArray a)
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p1 Int
len
Int
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a))
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p2 -> do
Ptr a -> PrimArray a -> Int -> Int -> IO ()
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
Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p2 Int
ix a
el
PrimArray a
arr3 <- Ptr a -> Int -> IO (PrimArray a)
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p2 Int
len
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 PrimArray a -> PrimArray a -> PropertyT IO ()
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 :: Gen a -> Property
primSetRangeAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Int
len <- Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genSmallArrayLen
(Int
low, Int
high) <- ((Int, Int) -> (Int, Int))
-> PropertyT IO (Int, Int) -> PropertyT IO (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> (Int, Int)
forall b. Ord b => (b, b) -> (b, b)
order (PropertyT IO (Int, Int) -> PropertyT IO (Int, Int))
-> PropertyT IO (Int, Int) -> PropertyT IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ (,)
(Int -> Int -> (Int, Int))
-> PropertyT IO Int -> PropertyT IO (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
PropertyT IO (Int -> (Int, Int))
-> PropertyT IO Int -> PropertyT IO (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Range Int -> Gen Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
a
el <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
(PrimArray a
arr2, PrimArray a
arr3) <- IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
-> PropertyT IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ do
Int
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a))
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p1 -> do
Int
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a))
-> (Ptr a -> IO (PrimArray a, PrimArray a))
-> IO (PrimArray a, PrimArray a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p2 -> do
PrimArray a
arr1 <- Gen a -> Int -> IO (PrimArray a)
forall a. Prim a => Gen a -> Int -> IO (PrimArray a)
genPrimArray Gen a
gen Int
len
Ptr a -> PrimArray a -> Int -> Int -> IO ()
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
Ptr a -> PrimArray a -> Int -> Int -> IO ()
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
Ptr a -> Int -> Int -> a -> IO ()
forall (m :: * -> *) a a.
(PrimMonad m, Prim a) =>
Ptr a -> Int -> Int -> a -> m ()
setOffPtr Ptr a
p1 Int
low (Int
high Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr2 <- Ptr a -> Int -> IO (PrimArray a)
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p1 Int
len
Ptr a -> Int -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> Int -> a -> m ()
defaultSetOffAddr Ptr a
p2 Int
low (Int
high Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
low) a
el
PrimArray a
arr3 <- Ptr a -> Int -> IO (PrimArray a)
forall a. Prim a => Ptr a -> Int -> IO (PrimArray a)
ptrToPrimArray Ptr a
p2 Int
len
(PrimArray a, PrimArray a) -> IO (PrimArray a, PrimArray a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray a
arr2, PrimArray a
arr3)
PrimArray a
arr2 PrimArray a -> PrimArray a -> PropertyT IO ()
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 b -> b -> Bool
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 =
(State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Addr#
-> Int#
-> Int#
-> a
-> State# (PrimState m)
-> State# (PrimState m)
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 :: Ptr a -> Int -> Int -> a -> m ()
defaultSetOffAddr (Ptr Addr#
addr#) (I# Int#
off#) (I# Int#
len#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Int# -> State# (PrimState m) -> State# (PrimState m)
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 Addr# -> Int# -> a -> State# s -> State# s
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 :: Gen a -> Property
primListRoundtripAddr Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
[a]
xs <- Gen [a] -> PropertyT IO [a]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
forall a b. (a -> b) -> a -> b
$ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
let len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
[a]
xs' <- IO [a] -> PropertyT IO [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> PropertyT IO [a]) -> IO [a] -> PropertyT IO [a]
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr a -> IO [a]) -> IO [a]
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
withBytes Int
len ((Ptr a -> IO [a]) -> IO [a]) -> (Ptr a -> IO [a]) -> IO [a]
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
let listToPtr :: Int -> [a] -> IO ()
listToPtr :: Int -> [a] -> IO ()
listToPtr !Int
ix = \case
[] -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(a
y:[a]
ys) -> Ptr a -> Int -> a -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr a
p Int
ix a
y IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> [a] -> IO ()
listToPtr (Int
ix Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
then [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else (:) (a -> [a] -> [a]) -> IO a -> IO ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> Int -> IO a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
readOffPtr Ptr a
p 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]
ptrToList (Int
ix Int -> Int -> Int
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 [a] -> [a] -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== [a]
xs'