-- |
-- Module:      Test.QuickCheck.Classes.MVector
-- Copyright:   (c) 2019 Andrew Lelechenko
-- Licence:     BSD3
--

{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wall #-}

#if !HAVE_VECTOR
module Test.QuickCheck.Classes.MVector where
#else

module Test.QuickCheck.Classes.MVector
  ( muvectorLaws
  ) where

import Control.Applicative
import Control.Monad (when)
import Control.Monad.ST
import Data.Functor
import Data.Proxy (Proxy)
import qualified Data.Vector.Generic.Mutable as MU (basicInitialize)
import qualified Data.Vector.Unboxed.Mutable as MU

import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property)

import Test.QuickCheck.Classes.Internal (Laws(..))

-- | Test that a 'Vector.Unboxed.MVector' instance obey several laws.
muvectorLaws :: (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Laws
muvectorLaws :: Proxy a -> Laws
muvectorLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Vector.Unboxed.MVector"
  [ (String
"New-Length", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
newLength Proxy a
p)
  , (String
"Replicate-Length", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
replicateLength Proxy a
p)
  , (String
"Slice-Length", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
sliceLength Proxy a
p)
  , (String
"Grow-Length", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
growLength Proxy a
p)

  , (String
"Write-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeRead Proxy a
p)
  , (String
"Set-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
setRead Proxy a
p)
  , (String
"Sliced-Set-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
slicedSetRead Proxy a
p)
  , (String
"Replicate-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
replicateRead Proxy a
p)

  , (String
"Slice-Overlaps", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
sliceOverlaps Proxy a
p)
  , (String
"Slice-Copy", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
sliceCopy Proxy a
p)
  , (String
"Slice-Move", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
sliceMove Proxy a
p)

  , (String
"Write-Copy-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeCopyRead Proxy a
p)
  , (String
"Write-Move-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeMoveRead Proxy a
p)
  , (String
"Write-Grow-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeGrowRead Proxy a
p)
  , (String
"Sliced-Write-Copy-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
slicedWriteCopyRead Proxy a
p)
  , (String
"Sliced-Write-Move-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
slicedWriteMoveRead Proxy a
p)
  , (String
"Sliced-Write-Grow-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
slicedWriteGrowRead Proxy a
p)

  , (String
"Write-InitializeAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeInitializeAroundRead Proxy a
p)
  , (String
"Write-ClearAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeClearAroundRead Proxy a
p)
  , (String
"Write-SetAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeSetAroundRead Proxy a
p)
  , (String
"Write-WriteAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeWriteAroundRead Proxy a
p)
  , (String
"Write-CopyAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeCopyAroundRead Proxy a
p)
  , (String
"Write-MoveAround-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeMoveAroundRead Proxy a
p)

  , (String
"Write-InitializeBetween-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeInitializeBetweenRead Proxy a
p)
  , (String
"Write-ClearBetween-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeClearBetweenRead Proxy a
p)
  , (String
"Write-SetBetween-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeSetBetweenRead Proxy a
p)
  , (String
"Write-CopyBetween-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeCopyBetweenRead Proxy a
p)
  , (String
"Write-MoveBetween-Read", Proxy a -> Property
forall a.
(Eq a, Unbox a, Arbitrary a, Show a) =>
Proxy a -> Property
writeMoveBetweenRead Proxy a
p)
  ]

-------------------------------------------------------------------------------
-- Length

newLength :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
newLength :: Proxy a -> Property
newLength Proxy a
_ = (NonNegative Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> Property) -> Property)
-> (NonNegative Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
len) -> do
  (Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
len) ((forall s. ST s Int) -> Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Int) -> Int) -> (forall s. ST s Int) -> Int
forall a b. (a -> b) -> a -> b
$ MVector s a -> Int
forall a s. Unbox a => MVector s a -> Int
MU.length (MVector s a -> Int) -> ST s (MVector s a) -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new Int
len :: ST s (MU.MVector s a)))

replicateLength :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
replicateLength :: Proxy a -> Property
replicateLength Proxy a
_ = (a -> NonNegative Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Property) -> Property)
-> (a -> NonNegative Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
len) -> do
  (Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
len) ((forall s. ST s Int) -> Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Int) -> Int) -> (forall s. ST s Int) -> Int
forall a b. (a -> b) -> a -> b
$ MVector s a -> Int
forall a s. Unbox a => MVector s a -> Int
MU.length (MVector s a -> Int) -> ST s (MVector s a) -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
len a
a)

sliceLength :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
sliceLength :: Proxy a -> Property
sliceLength Proxy a
_ = (NonNegative Int -> NonNegative Int -> Positive Int -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> NonNegative Int -> Positive Int -> Property)
 -> Property)
-> (NonNegative Int -> NonNegative Int -> Positive Int -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
ix) (NonNegative Int
subLen) (Positive Int
excess) -> do
  (Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
subLen) ((forall s. ST s Int) -> Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Int) -> Int) -> (forall s. ST s Int) -> Int
forall a b. (a -> b) -> a -> b
$ MVector s a -> Int
forall a s. Unbox a => MVector s a -> Int
MU.length (MVector s a -> Int)
-> (MVector s a -> MVector s a) -> MVector s a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
ix Int
subLen (MVector s a -> Int) -> ST s (MVector s a) -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
subLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) :: ST s (MU.MVector s a)))

growLength :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
growLength :: Proxy a -> Property
growLength Proxy a
_ = (Positive Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Positive Int -> Positive Int -> Property) -> Property)
-> (Positive Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(Positive Int
len) (Positive Int
by) -> do
  (Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
by) (Int -> Property) -> Int -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Int) -> Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Int) -> Int) -> (forall s. ST s Int) -> Int
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new Int
len :: ST s (MU.MVector s a)
    MVector s a -> Int
forall a s. Unbox a => MVector s a -> Int
MU.length (MVector s a -> Int) -> ST s (MVector s a) -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a
-> Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MU.grow MVector s a
MVector (PrimState (ST s)) a
arr Int
by

-------------------------------------------------------------------------------
-- Read

writeRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeRead :: Proxy a -> Property
writeRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

setRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
setRead :: Proxy a -> Property
setRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set MVector s a
MVector (PrimState (ST s)) a
arr a
a
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

slicedSetRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
slicedSetRead :: Proxy a -> Property
slicedSetRead Proxy a
_ = (a
 -> NonNegative Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) NonNegative Int
before NonNegative Int
after -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
before NonNegative Int
after (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set MVector s a
MVector (PrimState (ST s)) a
arr a
a
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

replicateRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
replicateRead :: Proxy a -> Property
replicateRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> a -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) a
a
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

-------------------------------------------------------------------------------
-- Overlaps

sliceOverlaps :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
sliceOverlaps :: Proxy a -> Property
sliceOverlaps Proxy a
_ = (NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
i) (NonNegative Int
ij) (NonNegative Int
jk) (NonNegative Int
kl) (NonNegative Int
lm) -> do
  let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k :: Int
k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
      l :: Int
l = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kl
      m :: Int
m = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lm
  Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
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
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: ST s (MU.MVector s a)
    let slice1 :: MVector s a
slice1 = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector s a
arr
        slice2 :: MVector s a
slice2 = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector s a
arr
    Bool -> ST s Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ MVector s a -> MVector s a -> Bool
forall a s. Unbox a => MVector s a -> MVector s a -> Bool
MU.overlaps MVector s a
slice1 MVector s a
slice2

sliceCopy :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
sliceCopy :: Proxy a -> Property
sliceCopy Proxy a
_ = (a
 -> NonNegative Int
 -> NonNegative Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> NonNegative Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> NonNegative Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
i) (NonNegative Int
ix) (Positive Int
excess) (NonNegative Int
ij) (NonNegative Int
jk) -> do
  let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k :: Int
k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
  (forall s. ST s Property) -> Property
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Property) -> Property)
-> (forall s. ST s Property) -> Property
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new Int
k :: ST s (MU.MVector s a)
    let src :: MVector s a
src = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
        dst :: MVector s a
dst = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
    if MVector s a -> MVector s a -> Bool
forall a s. Unbox a => MVector s a -> MVector s a -> Bool
MU.overlaps MVector s a
src MVector s a
dst then Property -> ST s Property
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True) else do
      MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
      MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
      a
valSrc <- MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
src Int
ix
      a
valDst <- MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix
      Property -> ST s Property
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
valSrc a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. a
valDst a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a)

sliceMove :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
sliceMove :: Proxy a -> Property
sliceMove Proxy a
_ = (a
 -> NonNegative Int
 -> NonNegative Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> NonNegative Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> NonNegative Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
i) (NonNegative Int
ix) (Positive Int
excess) (NonNegative Int
ij) (NonNegative Int
jk) -> do
  let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ij
      k :: Int
k = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jk
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new Int
k :: ST s (MU.MVector s a)
    let src :: MVector s a
src = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
i (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
        dst :: MVector s a
dst = Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
j (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess) MVector s a
arr
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

-------------------------------------------------------------------------------
-- Write + copy/move/grow

writeCopyRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeCopyRead :: Proxy a -> Property
writeCopyRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

writeMoveRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeMoveRead :: Proxy a -> Property
writeMoveRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

writeGrowRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeGrowRead :: Proxy a -> Property
writeGrowRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Positive Int -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Positive Int -> Property)
 -> Property)
-> (a
    -> NonNegative Int -> Positive Int -> Positive Int -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) (Positive Int
by) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- MVector (PrimState (ST s)) a
-> Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MU.grow MVector s a
MVector (PrimState (ST s)) a
src Int
by
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

slicedWriteCopyRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
slicedWriteCopyRead :: Proxy a -> Property
slicedWriteCopyRead Proxy a
_ = (a
 -> NonNegative Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) NonNegative Int
beforeSrc NonNegative Int
afterSrc NonNegative Int
beforeDst NonNegative Int
afterDst -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
beforeSrc NonNegative Int
afterSrc (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
beforeDst NonNegative Int
afterDst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

slicedWriteMoveRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
slicedWriteMoveRead :: Proxy a -> Property
slicedWriteMoveRead Proxy a
_ = (a
 -> NonNegative Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) NonNegative Int
beforeSrc NonNegative Int
afterSrc NonNegative Int
beforeDst NonNegative Int
afterDst -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
beforeSrc NonNegative Int
afterSrc (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
beforeDst NonNegative Int
afterDst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move MVector s a
MVector (PrimState (ST s)) a
dst MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

slicedWriteGrowRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
slicedWriteGrowRead :: Proxy a -> Property
slicedWriteGrowRead Proxy a
_ = (a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> NonNegative Int
 -> NonNegative Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> NonNegative Int
  -> NonNegative Int
  -> Property)
 -> Property)
-> (a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> NonNegative Int
    -> NonNegative Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) (Positive Int
by) NonNegative Int
beforeSrc NonNegative Int
afterSrc -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
forall a s.
Unbox a =>
NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice NonNegative Int
beforeSrc NonNegative Int
afterSrc (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
src Int
ix a
a
    MVector s a
dst <- MVector (PrimState (ST s)) a
-> Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MU.grow MVector s a
MVector (PrimState (ST s)) a
src Int
by
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear MVector s a
MVector (PrimState (ST s)) a
src
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

-------------------------------------------------------------------------------
-- Write + overwrite around

writeInitializeAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeInitializeAroundRead :: Proxy a -> Property
writeInitializeAroundRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> ST s ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MU.basicInitialize (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
arr)
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> ST s ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MU.basicInitialize (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr)
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

writeClearAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeClearAroundRead :: Proxy a -> Property
writeClearAroundRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
arr)
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr)
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

writeSetAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeSetAroundRead :: Proxy a -> Property
writeSetAroundRead Proxy a
_ = (a -> a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> a -> NonNegative Int -> Positive Int -> Property)
 -> Property)
-> (a -> a -> NonNegative Int -> Positive Int -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
arr) a
b
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr) a
b
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

writeWriteAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeWriteAroundRead :: Proxy a -> Property
writeWriteAroundRead Proxy a
_ = (a -> a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> a -> NonNegative Int -> Positive Int -> Property)
 -> Property)
-> (a -> a -> NonNegative Int -> Positive Int -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
b
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
b
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix

writeCopyAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeCopyAroundRead :: Proxy a -> Property
writeCopyAroundRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
src)
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
src)
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

writeMoveAroundRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeMoveAroundRead :: Proxy a -> Property
writeMoveAroundRead Proxy a
_ = (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> NonNegative Int -> Positive Int -> Property) -> Property)
-> (a -> NonNegative Int -> Positive Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (NonNegative Int
ix) (Positive Int
excess) -> do
  (a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a) (a -> Property) -> a -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst Int
ix a
a
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
ix MVector s a
src)
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
excess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
excess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
src)
    MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix

-------------------------------------------------------------------------------
-- Two writes + overwrite in between

writeInitializeBetweenRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeInitializeBetweenRead :: Proxy a -> Property
writeInitializeBetweenRead Proxy a
_ = (a
 -> a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> Property)
 -> Property)
-> (a
    -> a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
dix) (Positive Int
excess) -> do
  ((a, a) -> (a, a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a
a, a
b)) ((a, a) -> Property) -> (a, a) -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (a, a)) -> (a, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, a)) -> (a, a))
-> (forall s. ST s (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix) a
b
    MVector (PrimState (ST s)) a -> ST s ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MU.basicInitialize (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr)
    (,) (a -> a -> (a, a)) -> ST s a -> ST s (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix ST s (a -> (a, a)) -> ST s a -> ST s (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix)

writeClearBetweenRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeClearBetweenRead :: Proxy a -> Property
writeClearBetweenRead Proxy a
_ = (a
 -> a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> Property)
 -> Property)
-> (a
    -> a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
dix) (Positive Int
excess) -> do
  ((a, a) -> (a, a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a
a, a
b)) ((a, a) -> Property) -> (a, a) -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (a, a)) -> (a, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, a)) -> (a, a))
-> (forall s. ST s (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix) a
b
    MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m ()
MU.clear (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr)
    (,) (a -> a -> (a, a)) -> ST s a -> ST s (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix ST s (a -> (a, a)) -> ST s a -> ST s (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix)

writeSetBetweenRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeSetBetweenRead :: Proxy a -> Property
writeSetBetweenRead Proxy a
_ = (a
 -> a
 -> a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> a
  -> a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> Property)
 -> Property)
-> (a
    -> a
    -> a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (a
c :: a) (NonNegative Int
ix) (Positive Int
dix) (Positive Int
excess) -> do
  ((a, a) -> (a, a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a
a, a
b)) ((a, a) -> Property) -> (a, a) -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (a, a)) -> (a, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, a)) -> (a, a))
-> (forall s. ST s (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix) a
b
    MVector (PrimState (ST s)) a -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
arr) a
c
    (,) (a -> a -> (a, a)) -> ST s a -> ST s (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr Int
ix ST s (a -> (a, a)) -> ST s a -> ST s (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix)

writeCopyBetweenRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeCopyBetweenRead :: Proxy a -> Property
writeCopyBetweenRead Proxy a
_ = (a
 -> a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> Property)
 -> Property)
-> (a
    -> a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
dix) (Positive Int
excess) -> do
  ((a, a) -> (a, a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a
a, a
b)) ((a, a) -> Property) -> (a, a) -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (a, a)) -> (a, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, a)) -> (a, a))
-> (forall s. ST s (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix) a
b
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.copy (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
src)
    (,) (a -> a -> (a, a)) -> ST s a -> ST s (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix ST s (a -> (a, a)) -> ST s a -> ST s (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix)

writeMoveBetweenRead :: forall a. (Eq a, MU.Unbox a, Arbitrary a, Show a) => Proxy a -> Property
writeMoveBetweenRead :: Proxy a -> Property
writeMoveBetweenRead Proxy a
_ = (a
 -> a
 -> NonNegative Int
 -> Positive Int
 -> Positive Int
 -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((a
  -> a
  -> NonNegative Int
  -> Positive Int
  -> Positive Int
  -> Property)
 -> Property)
-> (a
    -> a
    -> NonNegative Int
    -> Positive Int
    -> Positive Int
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (a
b :: a) (NonNegative Int
ix) (Positive Int
dix) (Positive Int
excess) -> do
  ((a, a) -> (a, a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a
a, a
b)) ((a, a) -> Property) -> (a, a) -> Property
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (a, a)) -> (a, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, a)) -> (a, a))
-> (forall s. ST s (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s a
src <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector s a
dst <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
excess)
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst Int
ix a
a
    MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector s a
MVector (PrimState (ST s)) a
dst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix) a
b
    MVector (PrimState (ST s)) a
-> MVector (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.move (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
dst) (Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MVector s a
src)
    (,) (a -> a -> (a, a)) -> ST s a -> ST s (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst Int
ix ST s (a -> (a, a)) -> ST s a -> ST s (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector s a
MVector (PrimState (ST s)) a
dst (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dix)

-------------------------------------------------------------------------------
-- Utils

newSlice :: MU.Unbox a => NonNegative Int -> NonNegative Int -> Int -> ST s (MU.MVector s a)
newSlice :: NonNegative Int -> NonNegative Int -> Int -> ST s (MVector s a)
newSlice (NonNegative Int
before) (NonNegative Int
after) Int
len = do
  MVector s a
arr <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new (Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
after)
  MVector s a -> ST s (MVector s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector s a -> ST s (MVector s a))
-> MVector s a -> ST s (MVector s a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s a -> MVector s a
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
before Int
len MVector s a
arr

#endif